├── .gitignore ├── Ares.DPR ├── Ares.dproj ├── Ares_Icon.ico ├── AsyncExTypes.pas ├── BitTorrent ├── BDecode.pas ├── BitTorrentDlDb.pas ├── BitTorrentStringfunc.pas ├── BitTorrentUtils.pas ├── bittorrentConst.pas ├── btcore.pas ├── dht_consts.pas ├── dht_int160.pas ├── dht_routingbin.pas ├── dht_search.pas ├── dht_searchManager.pas ├── dht_socket.pas ├── dht_zones.pas ├── hashes.pas ├── thread_bitTorrent.pas └── torrentparser.pas ├── COMPILING.txt ├── DHT ├── dhtUtils.pas ├── dhtconsts.pas ├── dhtcontact.pas ├── dhthashlist.pas ├── dhtkeywords.pas ├── dhtroutingbin.pas ├── dhtsearch.pas ├── dhtsearchManager.pas ├── dhtsocket.pas ├── dhttypes.pas ├── dhtzones.pas ├── int128.pas └── thread_dht.pas ├── Drag_N_Drop.pas ├── LICENSE ├── README ├── README.md ├── Test ├── MainUnit.dfm ├── MainUnit.pas ├── Test.dpr ├── Test.dproj └── Test.res ├── VCLs ├── AresCp.dpk ├── AresCp.dproj ├── BGImPanel.pas ├── CometBtnEdit.pas ├── CometHint.pas ├── CometPageView.pas ├── CometTopicPnl.pas ├── CometTrack.pas ├── CometTrees.pas ├── CometTrees.res ├── CometTreesReg.pas ├── CometVerInfo.pas ├── Compilers.inc ├── FolderBrowse.pas ├── README.txt ├── ShockwaveEx.pas ├── ShockwaveList.pas ├── VCHeaderPopup.pas ├── WINSPLIT.RES ├── WinSplit.pas ├── WindowsXP.rc ├── XPMan.pas ├── XPbutton.pas ├── arescp.res ├── arescp_Icon.ico ├── bmpmplayer.res ├── bmptrackbar.res ├── mPlayerPanel.pas └── uTrayIcon.pas ├── ZLib.pas ├── adler32.obj ├── ares.ico ├── ares.res ├── ares_objects.pas ├── ares_types.pas ├── ares_types_root.pas ├── blcksock.pas ├── class_cmdlist.pas ├── classes2.pas ├── compress.obj ├── const_ares.pas ├── const_client.pas ├── const_commands.pas ├── const_commands_pfs.pas ├── const_supernode_commands.pas ├── const_timeouts.pas ├── const_udpTransfer.pas ├── const_win_messages.pas ├── crc32.obj ├── deflate.obj ├── flvplayer.RES ├── hashlist.pas ├── helpeR_ipfunc.pas ├── helper_GUI_misc.pas ├── helper_ICH.pas ├── helper_altsources.pas ├── helper_ares_nodes.pas ├── helper_arescol.pas ├── helper_autoscan.pas ├── helper_base64_32.pas ├── helper_bighints.pas ├── helper_channellist.pas ├── helper_chat_favorites.pas ├── helper_check_proxy.pas ├── helper_combos.pas ├── helper_crypt.pas ├── helper_datetime.pas ├── helper_diskio.pas ├── helper_download_disk.pas ├── helper_download_misc.pas ├── helper_fakes.pas ├── helper_filtering.pas ├── helper_findmore.pas ├── helper_graphs.pas ├── helper_hashlinks.pas ├── helper_host_discovery.pas ├── helper_http.pas ├── helper_library_db.pas ├── helper_manual_share.pas ├── helper_mimetypes.pas ├── helper_params.pas ├── helper_player.pas ├── helper_playlist.pas ├── helper_preview.pas ├── helper_registry.pas ├── helper_search_gui.pas ├── helper_share_misc.pas ├── helper_share_settings.pas ├── helper_skin.pas ├── helper_sockets.pas ├── helper_sorting.pas ├── helper_stringfinal.pas ├── helper_strings.pas ├── helper_supernode_crypt.pas ├── helper_unicode.pas ├── helper_upnp.pas ├── helper_urls.pas ├── helper_visual_headers.pas ├── helper_visual_library.pas ├── infback.obj ├── inffast.obj ├── inflate.obj ├── inftrees.obj ├── keywfunc.pas ├── mysupernodes.pas ├── peerguard.pas ├── securehash.pas ├── shoutcast.pas ├── synsock.pas ├── th_rbld.pas ├── thread_client.pas ├── thread_download.pas ├── thread_share.pas ├── thread_supernode.pas ├── thread_terminator.pas ├── thread_upload.pas ├── trees.obj ├── types_supernode.pas ├── uWhatImListeningTo.pas ├── uctrvol.dfm ├── uctrvol.pas ├── uflvplayer.pas ├── ufrm_settings.dfm ├── ufrm_settings.pas ├── ufrmabout.dfm ├── ufrmabout.pas ├── ufrmhint.dfm ├── ufrmhint.pas ├── ufrmmain.dfm ├── ufrmmain.pas ├── ufrmpreview.dfm ├── ufrmpreview.pas ├── umediar.pas ├── unetplayer.pas ├── uplaylistfrm.dfm ├── uplaylistfrm.pas ├── utility_ares.pas ├── vars_global.pas └── vars_localiz.pas /.gitignore: -------------------------------------------------------------------------------- 1 | # Uncomment these types if you want even more clean repository. But be careful. 2 | # It can make harm to an existing project source. Read explanations below. 3 | # 4 | # Resource files are binaries containing manifest, project icon and version info. 5 | # They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files. 6 | #*.res 7 | # 8 | # Type library file (binary). In old Delphi versions it should be stored. 9 | # Since Delphi 2009 it is produced from .ridl file and can safely be ignored. 10 | #*.tlb 11 | # 12 | # Diagram Portfolio file. Used by the diagram editor up to Delphi 7. 13 | # Uncomment this if you are not using diagrams or use newer Delphi version. 14 | #*.ddp 15 | # 16 | # Visual LiveBindings file. Added in Delphi XE2. 17 | # Uncomment this if you are not using LiveBindings Designer. 18 | #*.vlb 19 | # 20 | # Deployment Manager configuration file for your project. Added in Delphi XE2. 21 | # Uncomment this if it is not mobile development and you do not use remote debug feature. 22 | #*.deployproj 23 | # 24 | # C++ object files produced when C/C++ Output file generation is configured. 25 | # Uncomment this if you are not using external objects (zlib library for example). 26 | #*.obj 27 | # 28 | 29 | # Delphi compiler-generated binaries (safe to delete) 30 | *.exe 31 | *.dll 32 | *.bpl 33 | *.bpi 34 | *.dcp 35 | *.so 36 | *.apk 37 | *.drc 38 | *.map 39 | *.dres 40 | *.rsm 41 | *.tds 42 | *.dcu 43 | *.lib 44 | *.a 45 | *.o 46 | *.ocx 47 | 48 | # Delphi autogenerated files (duplicated info) 49 | *.cfg 50 | *.hpp 51 | *Resource.rc 52 | 53 | # Delphi local files (user-specific info) 54 | *.local 55 | *.identcache 56 | *.projdata 57 | *.tvsconfig 58 | *.dsk 59 | 60 | # Delphi history and backups 61 | __history/ 62 | __recovery/ 63 | *.~* 64 | 65 | # Castalia statistics file (since XE7 Castalia is distributed with Delphi) 66 | *.stat 67 | -------------------------------------------------------------------------------- /Ares.DPR: -------------------------------------------------------------------------------- 1 | { 2 | this file is part of Ares 3 | Aresgalaxy ( http://aresgalaxy.sourceforge.net ) 4 | 5 | This program is free software; you can redistribute it and/or 6 | modify it under the terms of the GNU General Public License 7 | as published by the Free Software Foundation; either 8 | version 2 of the License, or (at your option) any later version. 9 | 10 | This program is distributed in the hope that it will be useful, 11 | but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | GNU General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program; if not, write to the Free Software 17 | Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 18 | } 19 | 20 | 21 | { 22 | Description: 23 | init application, get commandline params(any magnet URI?), look for concurrent instances 24 | } 25 | 26 | program Ares; 27 | 28 | uses 29 | FastMM4 in 'FastMM4.pas', 30 | tntforms, 31 | Forms, 32 | windows, 33 | sysutils, 34 | ares_objects in 'ares_objects.pas', 35 | vars_global in 'vars_global.pas', 36 | helper_unicode in 'helper_unicode.pas', 37 | helper_params in 'helper_params.pas', 38 | ufrmmain in 'ufrmmain.pas' {ares_frmmain}, 39 | ufrmhint in 'ufrmhint.pas' {frmhint}, 40 | uctrvol in 'uctrvol.pas' {frmctrlvol}, 41 | ufrmpreview in 'ufrmpreview.pas' {frmpreview}, 42 | const_win_messages in 'const_win_messages.pas', 43 | const_ares in 'const_ares.pas', 44 | uWhatImListeningTo in 'uWhatImListeningTo.pas', 45 | uplaylistfrm in 'uplaylistfrm.pas' {PlaylistForm}, 46 | ufrm_settings in 'ufrm_settings.pas' {frm_settings}, 47 | ufrmabout in 'ufrmabout.pas' {frmabout}; 48 | 49 | {$R *.res} 50 | //{$E .exe} 51 | //{$R ares.RES} 52 | 53 | const 54 | STR_ARES_GLBMTX='AresGlbMtx_'; 55 | 56 | var 57 | adata,buf:string; 58 | p:pointer; 59 | hGlobalMutex:hwnd; 60 | ARES_GLOBAL_MUTEX_NAME:string; 61 | 62 | 63 | Function GetUsrName:string; 64 | Var 65 | UserName : string; 66 | UserNameLen : Dword; 67 | Begin 68 | UserNameLen := 255; 69 | SetLength(userName, UserNameLen) ; 70 | If GetUserName(PChar(UserName), UserNameLen) Then Result := Copy(UserName,1,UserNameLen - 1) 71 | else Result := STR_UNKNOWNS; 72 | End; 73 | 74 | procedure DoneApplication; 75 | begin 76 | with Application do 77 | begin 78 | if Handle <> 0 then ShowOwnedPopups(Handle, False); 79 | ShowHint := False; 80 | Destroying; 81 | DestroyComponents; 82 | end; 83 | end; 84 | 85 | begin 86 | IsMultiThread:=True; 87 | 88 | ARES_GLOBAL_MUTEX_NAME:=STR_ARES_GLBMTX+GetUsrName; 89 | hGlobalMutex:=OpenMutex(SYNCHRONIZE,FALSE,pchar(ARES_GLOBAL_MUTEX_NAME)); 90 | 91 | if hGlobalMutex<>0 then begin 92 | 93 | CloseHandle(hGlobalMutex); 94 | 95 | adata:=''; 96 | if WideParamCount=1 then adata:=widestrtoutf8str(Wideparamstr(1)) else 97 | if WideParamCount=2 then adata:=widestrtoutf8str(Wideparamstr(2)); 98 | 99 | if length(adata)>0 then begin 100 | if length(adata)>512 then delete(adata,513,length(adata)); 101 | setlength(buf,512); 102 | fillchar(buf[1],512,0); 103 | move(adata[1],buf[1],length(adata)); 104 | 105 | vars_global.glob_shared_mem:=tsharedmemory.create; 106 | vars_global.glob_shared_mem.OpenMap; 107 | 108 | 109 | vars_global.glob_shared_mem.LockMap; 110 | p:=pointer(cardinal(vars_global.glob_shared_mem.PMapData)); 111 | copymemory(p, @buf[1], 512); 112 | vars_global.glob_shared_mem.unLockMap; 113 | 114 | sleep(500); // enough time to create form? 115 | vars_global.glob_shared_mem.CloseMap; 116 | vars_global.glob_shared_mem.free; 117 | adata:=''; 118 | end; 119 | 120 | ARES_GLOBAL_MUTEX_NAME:=''; 121 | exit; 122 | 123 | end else begin 124 | 125 | hGlobalMutex:=CreateMutex(nil,TRUE,pchar(ARES_GLOBAL_MUTEX_NAME)); 126 | 127 | vars_global.glob_shared_mem:=tsharedmemory.create; 128 | vars_global.glob_shared_mem.OpenMap; 129 | 130 | try 131 | 132 | application.Initialize; 133 | application.Title:=' Ares '; 134 | application.ShowMainForm:=false; 135 | Application.CreateForm(Tares_frmmain, ares_frmmain); 136 | application.run; 137 | 138 | except 139 | end; 140 | 141 | vars_global.glob_shared_mem.CloseMap; 142 | vars_global.glob_shared_mem.free; 143 | 144 | ReleaseMutex(hGlobalMutex); 145 | CloseHandle(hGlobalMutex); 146 | ARES_GLOBAL_MUTEX_NAME:=''; 147 | 148 | 149 | end; 150 | 151 | 152 | end. 153 | -------------------------------------------------------------------------------- /Ares_Icon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CWBudde/AresGalaxy/b6136fd50c80f73be3115b315bb15bbbf9d1b528/Ares_Icon.ico -------------------------------------------------------------------------------- /AsyncExTypes.pas: -------------------------------------------------------------------------------- 1 | { 2 | this file is part of Ares 3 | Aresgalaxy ( http://aresgalaxy.sourceforge.net ) 4 | } 5 | 6 | unit AsyncExTypes; 7 | 8 | (* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 9 | * Copyright (C) 2004 - 2006 Martin Offenwanger * 10 | * Mail: coder@dsplayer.de * 11 | * Web: http://www.dsplayer.de * 12 | * * 13 | * This Program is free software; you can redistribute it and/or modify * 14 | * it under the terms of the GNU General Public License as published by * 15 | * the Free Software Foundation; either version 2, or (at your option) * 16 | * any later version. * 17 | * * 18 | * This Program is distributed in the hope that it will be useful, * 19 | * but WITHOUT ANY WARRANTY; without even the implied warranty of * 20 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * 21 | * GNU General Public License for more details. * 22 | * * 23 | * You should have received a copy of the GNU General Public License * 24 | * along with GNU Make; see the file COPYING. If not, write to * 25 | * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. * 26 | * http://www.gnu.org/copyleft/gpl.html * 27 | * * 28 | * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *) 29 | { 30 | @author(Martin Offenwanger: coder@dsplayer.de) 31 | @created(Apr 22, 2004) 32 | @lastmod(Apr 02, 2005) 33 | } 34 | 35 | interface 36 | 37 | uses ActiveX; 38 | 39 | const 40 | AsyncExFileName = 'AsyncEx.ax'; 41 | AsyncExFilterID = 'AsyncEx'; 42 | AsyncExPinID = 'StreamOut'; 43 | CLSID_AsyncEx: TGUID = '{3E0FA044-926C-42d9-BA12-EF16E980913B}'; 44 | IID_AsyncExControl: TGUID = '{3E0FA056-926C-43d9-BA18-EF16E980913B}'; 45 | IID_AsyncExCallBack: TGUID = '{3E0FB667-956C-43d9-BA18-EF16E980913B}'; 46 | PinID = 'StreamOut'; 47 | FilterID = 'AsyncEx'; 48 | 49 | type 50 | IAsyncExCallBack = interface(IUnknown) 51 | ['{3E0FB667-956C-43d9-BA18-EF16E980913B}'] 52 | function AsyncExFilterState(Buffering: LongBool; PreBuffering: LongBool; Connecting: LongBool; Playing: LongBool; BufferState: integer): HRESULT; stdcall; 53 | function AsyncExICYNotice(IcyItemName: PChar; ICYItem: PChar): HRESULT; stdcall; 54 | function AsyncExMetaData(Title: PChar; URL: PChar): HRESULT; stdcall; 55 | function AsyncExSockError(ErrString: PChar): HRESULT; stdcall; 56 | end; 57 | 58 | IAsyncExControl = interface(IUnknown) 59 | ['{3E0FA056-926C-43d9-BA18-EF16E980913B}'] 60 | function SetLoadFromStream(Stream: IStream; Length: int64): HRESULT; stdcall; 61 | function SetConnectToIp(Host: PChar; Port: PChar; Location: PChar; AgentName:pchar): HRESULT; stdcall; 62 | function SetConnectToURL(URL: PChar; AgentName:pchar): HRESULT; stdcall; 63 | function SetBuffersize(BufferSize: integer): HRESULT; stdcall; 64 | function GetBuffersize(out BufferSize: integer): HRESULT; stdcall; 65 | function SetRipStream(Ripstream: LongBool; Path: PwideChar; Filename: PwideChar): HRESULT; stdcall; 66 | function GetRipStream(out Ripstream: LongBool; out FileO: PwideChar): HRESULT; stdcall; 67 | function SetCallBack(CallBack: IAsyncExCallBack): HRESULT; stdcall; 68 | function FreeCallback(): HRESULT; stdcall; 69 | function ExitAllLoops(): HRESULT; stdcall; 70 | end; 71 | 72 | implementation 73 | 74 | end. 75 | 76 | -------------------------------------------------------------------------------- /BitTorrent/BDecode.pas: -------------------------------------------------------------------------------- 1 | { 2 | this file is part of Ares 3 | Aresgalaxy ( http://aresgalaxy.sourceforge.net ) 4 | 5 | This program is free software; you can redistribute it and/or 6 | modify it under the terms of the GNU General Public License 7 | as published by the Free Software Foundation; either 8 | version 2 of the License, or (at your option) any later version. 9 | 10 | This program is distributed in the hope that it will be useful, 11 | but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | GNU General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program; if not, write to the Free Software 17 | Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 18 | } 19 | 20 | { 21 | Description: 22 | this code is part of 'MakeTorrent' at http://sourceforge.net/projects/burst/ 23 | BDecode.pas -- BitTorrent BDecoding Routines 24 | Original Coding by Knowbuddy, 2003-03-19 25 | } 26 | 27 | unit BDecode; 28 | 29 | 30 | interface 31 | 32 | uses 33 | SysUtils, Classes, Contnrs, Hashes; 34 | 35 | type 36 | TISType=(tisString = 0, tisInt); 37 | 38 | TIntString = class(TObject) 39 | public 40 | StringPart: String; 41 | IntPart: Int64; 42 | ISType: TISType; 43 | destructor destroy; override; 44 | end; 45 | 46 | function bdecodeStream(s: TStream): TObject; 47 | function bdecodeInt64(s: TStream): TIntString; 48 | function bdecodeHash(s: TStream): TObjectHash; 49 | function bdecodeString(s: TStream; i:Integer=0): TIntString; 50 | function bdecodeList(s: TStream): TObjectList; 51 | function bin2hex(s: string; m:Integer=999): string; 52 | 53 | var 54 | hexchars: array [0..15] of Char='0123456789abcdef'; 55 | 56 | implementation 57 | 58 | uses 59 | Windows; 60 | 61 | destructor TIntString.destroy; 62 | begin 63 | StringPart := ''; 64 | inherited; 65 | end; 66 | 67 | function bin2hex(s: string; m:Integer=999): string; 68 | var 69 | i,j,k,l: Integer; 70 | r: array of Char; 71 | begin 72 | l := Length(s); 73 | if (m0) then begin 92 | case c of 93 | 'd':r := bdecodeHash(s); 94 | 'l':r := bdecodeList(s); 95 | 'i':r := bdecodeInt64(s); 96 | '0'..'9':r := bdecodeString(s,StrToInt(c)); 97 | else begin 98 | 99 | r := nil; 100 | end; 101 | end; 102 | end else begin 103 | 104 | r := nil; 105 | end; 106 | bdecodeStream := r; 107 | end; 108 | 109 | function bdecodeHash(s: TStream): TObjectHash; 110 | var 111 | r: TObjectHash; 112 | o: TObject; 113 | n,st: Integer; 114 | c:Char; 115 | k,l: TIntString; 116 | begin 117 | r := TObjectHash.Create(); 118 | n := s.Read(c,1); 119 | while ((n>0) and (c<>'e') and (c>='0') and (c<='9')) do begin 120 | n := StrToInt(c); 121 | 122 | k := bdecodeString(s, n); 123 | if (k<>nil) then begin 124 | st := s.Position; 125 | o := bdecodeStream(s); 126 | if ((o<>nil) and (k.StringPart<>'')) then r[k.StringPart] := o; 127 | if (k.StringPart='pieces') then k.StringPart := 'pieces'; 128 | if (k.StringPart='info') then begin 129 | l := TIntString.Create(); 130 | l.IntPart := st; 131 | r['_info_start'] := l; 132 | l := TIntString.Create(); 133 | l.IntPart := s.Position-st; 134 | r['_info_length'] := l; 135 | end; 136 | 137 | //k.StringPart := ''; 138 | k.Free; 139 | 140 | end; 141 | 142 | n := s.Read(c, 1); // endof 143 | 144 | end; 145 | 146 | 147 | if ((c<'0') or (c>'9')) and (c<>'e') then bdecodeHash := nil 148 | else bdecodeHash := r; 149 | end; 150 | 151 | function bdecodeList(s: TStream): TObjectList; 152 | var 153 | r: TObjectList; 154 | o: TObject; 155 | n: Integer; 156 | c:Char; 157 | begin 158 | r := TObjectList.Create(); 159 | n := s.Read(c, 1); 160 | while ((n>0) and (c<>'e')) do begin 161 | s.Seek(-1,soFromCurrent); 162 | o := bdecodeStream(s); 163 | if (o<>nil) then r.Add(o); 164 | n := s.Read(c, 1); 165 | end; 166 | bdecodeList := r; 167 | end; 168 | 169 | function bdecodeString(s: TStream; i:Integer=0): TIntString; 170 | var 171 | r: TIntString; 172 | t: string; 173 | c:Char; 174 | n: Integer; 175 | begin 176 | c := '0'; 177 | n := s.Read(c,1); 178 | while ((n >0) and (c>='0') and (c<='9')) do begin 179 | i := (i * 10)+StrToInt(c); 180 | n := s.Read(c,1); 181 | end; 182 | 183 | SetLength(t,i); 184 | // n := 185 | s.Read(PChar(t)^,i); 186 | 187 | r := TIntString.Create(); 188 | r.StringPart := copy(t,1,length(t)); 189 | r.ISType := tisString; 190 | SetLength(t,0); 191 | 192 | bdecodeString := r; 193 | end; 194 | 195 | function bdecodeInt64(s: TStream): TIntString; 196 | var 197 | r: TIntString; 198 | i: Int64; 199 | c:Char; 200 | n: Integer; 201 | neg: Boolean; 202 | begin 203 | i := 0; 204 | c := '0'; 205 | neg := False; 206 | repeat 207 | if c='-' then neg := true else i := (i*10)+StrToInt(c); 208 | n := s.Read(c,1); 209 | until not ((n>0) and (((c>='0') and (c<='9')) or (c='-'))); 210 | 211 | if neg then i := -i; 212 | 213 | r := TIntString.Create(); 214 | r.IntPart := i; 215 | r.ISType := tisInt; 216 | 217 | bdecodeInt64 := r; 218 | end; 219 | 220 | end. 221 | -------------------------------------------------------------------------------- /BitTorrent/BitTorrentStringfunc.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CWBudde/AresGalaxy/b6136fd50c80f73be3115b315bb15bbbf9d1b528/BitTorrent/BitTorrentStringfunc.pas -------------------------------------------------------------------------------- /BitTorrent/bittorrentConst.pas: -------------------------------------------------------------------------------- 1 | { 2 | this file is part of Ares 3 | Aresgalaxy ( http://aresgalaxy.sourceforge.net ) 4 | 5 | This program is free software; you can redistribute it and/or 6 | modify it under the terms of the GNU General Public License 7 | as published by the Free Software Foundation; either 8 | version 2 of the License, or (at your option) any later version. 9 | 10 | This program is distributed in the hope that it will be useful, 11 | but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | GNU General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program; if not, write to the Free Software 17 | Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 18 | } 19 | 20 | { 21 | Description: 22 | main bittorrent constants 23 | } 24 | 25 | unit bittorrentConst; 26 | 27 | interface 28 | 29 | uses 30 | Classes, helper_datetime, const_ares; 31 | 32 | const 33 | TIMEOUTTCPCONNECTION = 10 * SECOND; 34 | TIMEOUTTCPRECEIVE = 15 * SECOND; 35 | 36 | TIMEOUTTCPCONNECTIONTRACKER = 15 * SECOND; 37 | TIMEOUTTCPRECEIVETRACKER = 30 * SECOND; 38 | 39 | BTSOURCE_CONN_ATTEMPT_INTERVAL = MINUTE; 40 | BT_MAXSOURCE_FAILED_ATTEMPTS = 2; 41 | BTKEEPALIVETIMEOUT = 2*MINUTE; 42 | 43 | BITTORRENT_PIECE_LENGTH = 16 * KBYTE; 44 | EXPIRE_OUTREQUEST_INTERVAL = 60 * SECOND; 45 | INTERVAL_REREQUEST_WHENNOTCHOCKED = 10 * SECOND; 46 | 47 | TRACKER_NUMPEER_REQUESTED = 100; 48 | BITTORRENT_INTERVAL_BETWEENCHOKES = 10 * SECOND; 49 | BITTORENT_MAXNUMBER_CONNECTION_ESTABLISH = 35; 50 | BITTORENT_MAXNUMBER_CONNECTION_ACCEPTED = 55; 51 | TRACKERINTERVAL_WHENFAILED = 2 * MINUTE; 52 | BITTORRENT_MAX_ALLOWED_SOURCES = 300; 53 | BITTORRENT_DONTASKMORESOURCES = 200; 54 | SEVERE_LEECHING_RATIO = 10; 55 | NUMMAX_SOURCES_DOWNLOADING = 4; 56 | MAX_OUTGOING_ATTEMPTS = 3; 57 | MAXNUM_OUTBUFFER_PACKETS = 10; 58 | NUMMAX_TRANSFER_HASHFAILS = 8; 59 | NUMMAX_SOURCE_HASHFAILS = 4; 60 | STR_BITTORRENT_PROTOCOL_HANDSHAKE = chr(19)+'BitTorrent protocol'; 61 | STR_BITTORRENT_PROTOCOL_EXTENSIONS = 62 | CHRNULL{chr($80)} + CHRNULL + CHRNULL + CHRNULL + 63 | CHRNULL + chr($10) + CHRNULL + chr(1); // support extension protocol + dht 64 | TORRENT_DONTSHARE_INTERVAL = 2592000; //30 days 65 | 66 | CMD_BITTORRENT_CHOKE = 0; 67 | CMD_BITTORRENT_UNCHOKE = 1; 68 | CMD_BITTORRENT_INTERESTED = 2; 69 | CMD_BITTORRENT_NOTINTERESTED = 3; 70 | CMD_BITTORRENT_HAVE = 4; 71 | CMD_BITTORRENT_BITFIELD = 5; 72 | CMD_BITTORRENT_REQUEST = 6; 73 | CMD_BITTORRENT_PIECE = 7; 74 | CMD_BITTORRENT_CANCEL = 8; 75 | CMD_BITTORRENT_DHTUDPPORT = 9; 76 | 77 | // fast peer extensions 78 | CMD_BITTORRENT_SUGGESTPIECE = 13; 79 | CMD_BITTORRENT_HAVEALL = 14; 80 | CMD_BITTORRENT_HAVENONE = 15; 81 | CMD_BITTORRENT_REJECTREQUEST = 16; 82 | CMD_BITTORRENT_ALLOWEDFAST = 17; 83 | 84 | // extension protocol 85 | CMD_BITTORRENT_EXTENSION = 20; 86 | OPCODE_EXTENDED_HANDSHAKE = 0; 87 | OUR_UT_PEX_OPCODE = 1; 88 | OUR_UT_METADATA_OPCODE = 2; 89 | 90 | // dummy value for addpacket procedure 91 | CMD_BITTORRENT_KEEPALIVE = 100; 92 | CMD_BITTORRENT_UNKNOWN = 101; 93 | 94 | implementation 95 | 96 | end. 97 | -------------------------------------------------------------------------------- /BitTorrent/dht_consts.pas: -------------------------------------------------------------------------------- 1 | { 2 | this file is part of Ares 3 | Aresgalaxy ( http://aresgalaxy.sourceforge.net ) 4 | 5 | This program is free software; you can redistribute it and/or 6 | modify it under the terms of the GNU General Public License 7 | as published by the Free Software Foundation; either 8 | version 2 of the License, or (at your option) any later version. 9 | 10 | This program is distributed in the hope that it will be useful, 11 | but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | GNU General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program; if not, write to the Free Software 17 | Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 18 | 19 | ***************************************************************** 20 | The following delphi code is based on Emule (0.46.2.26) Kad's implementation http://emule.sourceforge.net 21 | and KadC library http://kadc.sourceforge.net/ 22 | ***************************************************************** 23 | } 24 | 25 | { 26 | Description: 27 | DHT constants, Ares flavor byte and opcodes have been changed 28 | to avoid any problem with other existent DHT networks 29 | } 30 | 31 | unit dht_consts; 32 | 33 | interface 34 | 35 | uses 36 | Dht_int160, Classes2; 37 | 38 | type 39 | TMDhtSearchType = ( 40 | UNDEFINED, 41 | NODE, 42 | NODECOMPLETE, 43 | FINDSOURCE 44 | ); 45 | 46 | const 47 | MDHT_TYPE_ERROR = 0; 48 | MDHT_TYPE_QUERY = 1; 49 | MDHT_TYPE_REPLY = 2; 50 | 51 | MDHT_K8 = 10; 52 | MDHT_KPINGABLE = 4; 53 | MDHT_KBASE = 4; 54 | MDHT_KK = 5; 55 | MDHT_ALPHA_QUERY = 3; 56 | MDHT_LOG_BASE_EXPONENT = 5; 57 | MDHT_SEARCH_LIFETIME = 45; 58 | MDHT_SEARCHNODE_LIFETIME = 45; 59 | MDHT_SEARCHNODECOMP_LIFETIME = 10; 60 | MDHT_SEARCHFINDSOURCE_LIFETIME = 80; 61 | MDHT_SEARCHNODECOMP_TOTAL = 10; 62 | MDHT_SEARCHFINDSOURCE_TOTAL = 60; 63 | MDHT_SEARCH_TOLERANCE = 16777216; 64 | 65 | 66 | MDHT_DISCONNECTDELAY = 1200; //20 mins in seconds 67 | 68 | MDHT_ACTION_NONE = 0; 69 | MDHT_PING_REQ = 1; 70 | MDHT_GETPEER_REQ = 2; 71 | MDHT_FINDNODE_REQ = 3; 72 | MDHT_ANNOUNCEPEER_REQ = 4; 73 | 74 | type 75 | TMDhtBucket = class(TObject) 76 | ipC: Cardinal; 77 | portW: Word; 78 | id:CU_INT160; 79 | m_distance:CU_Int160; 80 | lastcontact: Cardinal; 81 | lastping: Cardinal; 82 | m_type: Byte; 83 | m_expires: Cardinal; 84 | m_inUse: Cardinal; 85 | m_rtt: Cardinal; 86 | m_created: Cardinal; 87 | m_lastTypeSet: Cardinal; 88 | constructor create; // Common var initialization goes here 89 | procedure init(const clientID:pCU_Int160; ip: Cardinal; udpPort: Word; const target:pCU_Int160); 90 | procedure checkingType; 91 | procedure updateType; 92 | end; 93 | 94 | PRecord_mdht_announced_torrent = ^Record_mdht_announced_torrent; 95 | Record_mdht_announced_torrent = record 96 | hash: string; 97 | last: Cardinal; 98 | clients: TMyStringList; 99 | end; 100 | 101 | implementation 102 | 103 | uses 104 | helper_datetime; 105 | 106 | procedure TMDhtBucket.init(const clientID: pCU_Int160; ip: Cardinal; 107 | udpPort: Word; const target:pCU_Int160); 108 | begin 109 | CU_INT160_Fill(@ID,clientID); 110 | CU_INT160_FillNXor(@m_distance,@ID,target); 111 | ipC := ip; 112 | portW := udpPort; 113 | end; 114 | 115 | constructor TMDhtBucket.create; 116 | begin 117 | m_type := 3; 118 | m_expires := 0; 119 | m_lastTypeSet := time_now; 120 | m_created := m_lastTypeSet; 121 | m_inUse := 0; 122 | m_rtt := 0; 123 | end; 124 | 125 | procedure TMDhtBucket.checkingType; 126 | begin 127 | if ((time_now-m_lastTypeSet<10) or 128 | (m_type=4)) then exit; 129 | 130 | m_lastTypeSet := time_now; 131 | 132 | m_expires := m_lastTypeSet + MIN2S(2); 133 | inc(m_type); 134 | end; 135 | 136 | procedure TMDhtBucket.updateType; 137 | var 138 | hours: Cardinal; 139 | begin 140 | hours := (time_now-m_created) div HR2S(1); 141 | case hours of 142 | 0: 143 | begin 144 | m_type := 2; 145 | m_expires := time_now+HR2S(1); 146 | end; 147 | 1: 148 | begin 149 | m_type := 1; 150 | m_expires := time_now+HR2S(1.5); 151 | end 152 | else 153 | begin 154 | m_type := 0; 155 | m_expires := time_now+HR2S(2); 156 | end; 157 | end; 158 | end; 159 | 160 | end. 161 | -------------------------------------------------------------------------------- /BitTorrent/dht_routingbin.pas: -------------------------------------------------------------------------------- 1 | { 2 | this file is part of Ares 3 | Aresgalaxy ( http://aresgalaxy.sourceforge.net ) 4 | 5 | This program is free software; you can redistribute it and/or 6 | modify it under the terms of the GNU General Public License 7 | as published by the Free Software Foundation; either 8 | version 2 of the License, or (at your option) any later version. 9 | 10 | This program is distributed in the hope that it will be useful, 11 | but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | GNU General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program; if not, write to the Free Software 17 | Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 18 | 19 | ***************************************************************** 20 | The following delphi code is based on Emule (0.46.2.26) Kad's implementation http://emule.sourceforge.net 21 | and KadC library http://kadc.sourceforge.net/ 22 | ***************************************************************** 23 | } 24 | 25 | { 26 | Description: 27 | DHT routing bin, each routingzone may have up to 10 contacts in its routing bin 28 | } 29 | 30 | unit dht_routingbin; 31 | 32 | interface 33 | 34 | uses 35 | Classes, SysUtils, Windows, Classes2, Dht_int160, Dht_Consts; 36 | 37 | type 38 | TMDHTRoutingBin = class(TObject) 39 | m_entries: TMylist; 40 | m_dontDeletecontacts: Boolean; 41 | constructor create; 42 | destructor destroy; override; 43 | function getContact(id:pCU_INT160): Tmdhtbucket; 44 | function add(contact: Tmdhtbucket): Boolean; 45 | function remove(contact: Tmdhtbucket): Boolean; 46 | procedure getEntries(list: TMylist; emptyFirst:boolean = false); 47 | function getOldest: Tmdhtbucket; 48 | function getClosestTo(maxType: Cardinal; target:pCU_INT160; maxRequired: Cardinal; 49 | ContactMap: TMylist; emptyFirst:boolean=false; inUse:boolean=false): Cardinal; 50 | procedure setAlive(ip: Cardinal; port:word); 51 | procedure moveback(c: Tmdhtbucket); 52 | function FindHost(ip: Cardinal): Tmdhtbucket; 53 | end; 54 | 55 | implementation 56 | 57 | uses 58 | helper_ipfunc, thread_bittorrent, DhtContact; 59 | 60 | function TMDHTRoutingBin.FindHost(ip: Cardinal): Tmdhtbucket; 61 | var 62 | i: Integer; 63 | c: Tmdhtbucket; 64 | begin 65 | Result := nil; 66 | if m_entries.count=0 then Exit; 67 | 68 | for i := 0 to m_entries.count-1 do 69 | begin 70 | c := m_entries[i]; 71 | if ip=c.ipC then 72 | begin 73 | Result := c; 74 | Exit; 75 | end; 76 | end; 77 | end; 78 | 79 | procedure TMDHTRoutingBin.getEntries(list: TMylist; emptyFirst:boolean = false); 80 | var 81 | i: Integer; 82 | con: Tmdhtbucket; 83 | begin 84 | if emptyFirst then 85 | list.clear; 86 | 87 | for i := 0 to m_entries.count-1 do 88 | begin 89 | con := m_entries[i]; 90 | list.add(con); 91 | end; 92 | end; 93 | 94 | function TMDHTRoutingBin.getContact(id:pCU_INT160): Tmdhtbucket; 95 | var 96 | con: Tmdhtbucket; 97 | i: Integer; 98 | begin 99 | Result := nil; 100 | 101 | for i := 0 to m_entries.count-1 do 102 | begin 103 | con := m_entries[i]; 104 | if con.ID[0]<>id[0] then continue; 105 | if con.ID[1]<>id[1] then continue; 106 | if con.ID[2]<>id[2] then continue; 107 | if con.ID[3]<>id[3] then continue; 108 | if con.ID[4]<>id[4] then continue; 109 | 110 | Result := con; 111 | Exit; 112 | end; 113 | 114 | end; 115 | 116 | procedure TMDHTRoutingBin.setAlive(ip: Cardinal; port: Word); 117 | var 118 | c: Tmdhtbucket; 119 | i: Integer; 120 | begin 121 | if m_entries.count=0 then Exit; 122 | 123 | for i := 0 to m_entries.count-1 do 124 | begin 125 | c := m_entries[i]; 126 | if (ip=c.ipC) and (port=c.portW) then 127 | begin 128 | c.updateType; 129 | 130 | break; 131 | end; 132 | end; 133 | end; 134 | 135 | function TMDHTRoutingBin.getClosestTo(maxType: Cardinal; target:pCU_INT160; maxRequired: Cardinal; 136 | ContactMap: TMylist; emptyFirst:boolean=false; inUse:boolean=false): Cardinal; 137 | var 138 | i: Integer; 139 | con: Tmdhtbucket; 140 | begin 141 | Result := 0; 142 | if m_entries.count=0 then Exit; 143 | 144 | if emptyFirst then ContactMap.clear; 145 | 146 | //Put results in sort order for target. 147 | for i := 0 to m_entries.count-1 do 148 | begin 149 | con := m_entries[i]; 150 | if con.m_type>maxType then continue; 151 | 152 | ContactMap.add(con); 153 | if inUse then inc(con.m_inUse); 154 | 155 | end; 156 | 157 | thread_bittorrent.mdht_sortCloserContacts(ContactMap, target); //@contact.me 158 | 159 | while (ContactMap.count>maxRequired) do 160 | begin 161 | if inUse then 162 | begin 163 | con := ContactMap[ContactMap.count-1]; 164 | dec(con.m_inuse); 165 | end; 166 | ContactMap.delete(ContactMap.count-1); // delete extra results 167 | end; 168 | 169 | Result := ContactMap.count; 170 | end; 171 | 172 | function TMDHTRoutingBin.remove(contact: Tmdhtbucket): Boolean; 173 | var 174 | ind: Integer; 175 | begin 176 | Result := False; 177 | 178 | ind := m_entries.indexof(contact); 179 | if ind<>-1 then 180 | begin 181 | m_entries.delete(ind); 182 | Result := True; 183 | end; 184 | end; 185 | 186 | function TMDHTRoutingBin.add(contact: Tmdhtbucket): Boolean; 187 | var 188 | c: Tmdhtbucket; 189 | begin 190 | Result := False; 191 | 192 | // If this is already in the entries list 193 | c := getContact(@Contact.ID); 194 | if (c<>nil) then 195 | begin 196 | // Move to the end of the list 197 | moveback(c); 198 | Result := False; 199 | Exit; 200 | end; 201 | 202 | // If not full, add to end of list 203 | if m_entries.count Adding bucket:'+CU_INT160_tohexstr(@contact.id,false))); 208 | end 209 | else 210 | Result := False; //bin full 211 | end; 212 | 213 | procedure TMDHTRoutingBin.moveback(c: Tmdhtbucket); 214 | var 215 | ind: Integer; 216 | begin 217 | ind := m_entries.indexof(c); 218 | 219 | if (ind<>-1) and (ind<>m_entries.count-1) then 220 | begin 221 | m_entries.delete(ind); 222 | m_entries.add(c); 223 | end; 224 | end; 225 | 226 | 227 | function TMDHTRoutingBin.getOldest: Tmdhtbucket; 228 | begin 229 | if m_entries.count>0 then 230 | Result := m_entries[0] 231 | else 232 | Result := nil; 233 | end; 234 | 235 | constructor TMDHTRoutingBin.create; 236 | begin 237 | m_dontDeleteContacts := False; 238 | m_entries := Tmylist.create; 239 | end; 240 | 241 | destructor TMDHTRoutingBin.destroy; 242 | var 243 | con: Tmdhtbucket; 244 | begin 245 | if not m_dontDeleteContacts then 246 | while (m_entries.count>0) do 247 | begin 248 | con := m_entries[m_entries.count-1]; 249 | m_entries.delete(m_entries.count-1); 250 | con.Free; 251 | end; 252 | 253 | m_entries.Free; 254 | 255 | inherited; 256 | end; 257 | 258 | end. 259 | -------------------------------------------------------------------------------- /BitTorrent/dht_searchManager.pas: -------------------------------------------------------------------------------- 1 | { 2 | this file is part of Ares 3 | Aresgalaxy ( http://aresgalaxy.sourceforge.net ) 4 | 5 | This program is free software; you can redistribute it and/or 6 | modify it under the terms of the GNU General Public License 7 | as published by the Free Software Foundation; either 8 | version 2 of the License, or (at your option) any later version. 9 | 10 | This program is distributed in the hope that it will be useful, 11 | but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | GNU General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program; if not, write to the Free Software 17 | Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 18 | 19 | ***************************************************************** 20 | The following delphi code is based on Emule (0.46.2.26) Kad's implementation http://emule.sourceforge.net 21 | and KadC library http://kadc.sourceforge.net/ 22 | ***************************************************************** 23 | } 24 | 25 | { 26 | Description: 27 | DHT high level routines related to searches 28 | } 29 | 30 | unit dht_searchManager; 31 | 32 | interface 33 | 34 | uses 35 | classes,classes2,dht_int160,dht_consts,dht_search,sysutils,thread_bittorrent,btcore,utility_ares; 36 | 37 | function findNode(findid:pCU_INT160): Boolean; 38 | function findNodeComplete: Boolean; 39 | function alreadySearchingFor(target:pCU_INT160): Boolean; 40 | procedure processResponse(targetSearch: Tmdhtsearch; fromIP: Cardinal; fromPort: Word; 41 | results: TMylist; garbageList: TMylist); 42 | procedure CheckSearches(nowt: Cardinal); //every second 43 | function num_searches(ttype:dht_consts.tmdhtsearchtype): Integer; 44 | procedure ClearContacts(list: TMylist); 45 | function mdht_get_peers(transfer: TbittorrentTransfer): Boolean; 46 | 47 | 48 | implementation 49 | 50 | uses 51 | helper_datetime,helper_ipfunc,securehash, 52 | windows,helper_strings,dht_Socket,mysupernodes; 53 | 54 | 55 | 56 | function num_searches(ttype:dht_consts.tmdhtsearchtype): Integer; 57 | var 58 | i: Integer; 59 | s: TmDHTSearch; 60 | begin 61 | Result := 0; 62 | 63 | for i := 0 to MDHT_Searches.count-1 do begin 64 | s := MDHT_Searches[i]; 65 | if s.m_type=ttype then inc(result); 66 | end; 67 | 68 | end; 69 | 70 | 71 | procedure ClearContacts(list: TMylist); 72 | var 73 | c: Tmdhtbucket; 74 | begin 75 | while (list.count>0) do begin 76 | c := list[list.count-1]; 77 | list.delete(list.count-1); 78 | c.Free; 79 | end; 80 | end; 81 | 82 | procedure processResponse(targetSearch: Tmdhtsearch; fromIP: Cardinal; fromPort: Word; 83 | results: TMylist; garbageList: TMylist); 84 | var 85 | s: TmDHTsearch; 86 | i: Integer; 87 | found: Boolean; 88 | begin 89 | found := False; 90 | s := nil; 91 | 92 | for i := 0 to MDHT_searches.count-1 do begin 93 | s := MDHT_searches[i]; 94 | if s=targetSearch then begin 95 | found := True; 96 | break; 97 | end; 98 | end; 99 | 100 | if not found then begin 101 | ClearContacts(GarbageList); 102 | exit; 103 | end; 104 | 105 | s.processResponse(fromIP, fromPort, results); 106 | end; 107 | 108 | 109 | 110 | function alreadySearchingFor(target:pCU_INT160): Boolean; 111 | var 112 | i: Integer; 113 | s: TmDHTsearch; 114 | begin 115 | result := False; 116 | 117 | for i := 0 to MDHT_Searches.count-1 do begin 118 | s := MDHT_Searches[i]; 119 | if CU_INT160_Compare(@s.m_target, target) then begin 120 | Result := True; 121 | exit; 122 | end; 123 | end; 124 | 125 | end; 126 | 127 | function findNodeComplete: Boolean; 128 | var 129 | s: TmDHTsearch; 130 | wantedid:cu_int160; 131 | begin 132 | result := False; 133 | 134 | CU_INT160_copyFromBufferRev(@DHTme160,@wantedid); 135 | if alreadySearchingFor(@wantedid) then exit; 136 | 137 | 138 | s := TmDHTsearch.create; 139 | s.m_type := dht_consts.NODECOMPLETE; 140 | CU_INT160_fill(@s.m_target,@wantedid); 141 | MDHT_Searches.add(s); 142 | Result := s.startIDSearch; 143 | end; 144 | 145 | function findNode(findid:pCU_INT160): Boolean; 146 | var 147 | s: TmDHTsearch; 148 | wantedid:cu_int160; 149 | begin 150 | result := False; 151 | 152 | CU_INT160_copyFromBufferRev(@findid,@wantedid); 153 | if alreadySearchingFor(@wantedid) then begin 154 | exit; 155 | end; 156 | 157 | s := TmDHTsearch.create; 158 | s.m_type := dht_consts.NODE; 159 | CU_INT160_fill(@s.m_target,@wantedid); 160 | MDHT_Searches.add(s); 161 | result := s.StartIDSearch; 162 | end; 163 | 164 | function mdht_get_peers(transfer: TbittorrentTransfer): Boolean; 165 | var 166 | id:CU_INT160; 167 | s: TmDHTsearch; 168 | begin 169 | result := False; 170 | 171 | CU_INT160_copyFromBufferRev(@transfer.fhashvalue[1],@id); 172 | 173 | if alreadySearchingFor(@id) then begin 174 | exit; 175 | end; 176 | 177 | s := TmDHTsearch.create; 178 | s.m_type := dht_consts.FINDSOURCE; 179 | CU_INT160_fill(@s.m_target,@id); 180 | MDHT_Searches.add(s); 181 | Utility_ares.debuglog('DHT finding peers for '+bytestr_to_hexstr(transfer.fhashvalue)); 182 | if s.StartIDSearch then begin 183 | transfer.m_lastudpsearch := mdht_nowt; 184 | Result := True; 185 | end; 186 | end; 187 | 188 | 189 | procedure CheckSearches(nowt: Cardinal); //every second 190 | var 191 | i: Integer; 192 | s: TmDHTSearch; 193 | begin 194 | 195 | i := 0; 196 | while (i=MDHT_SEARCHFINDSOURCE_TOTAL) or 210 | (s.m_created+MDHT_SEARCHFINDSOURCE_LIFETIME-SEC(5)=MDHT_SEARCHNODECOMP_TOTAL)) then begin 238 | 239 | MDHT_Searches.delete(i); 240 | s.Free; 241 | continue; 242 | end; 243 | s.CheckExpire; 244 | 245 | end 246 | else begin 247 | if s.m_created+MDHT_SEARCH_LIFETIME0) do begin 81 | outpacket := mdht_outpackets[mdht_outpackets.count-1]; 82 | mdht_outpackets.delete(mdht_outpackets.count-1); 83 | freemem(outpacket,sizeof(record_outpacket)); 84 | end; 85 | mdht_outpackets.Free; 86 | end; 87 | 88 | function mdht_find_outpacket(packetid: Word; remoteipC: Cardinal; remoteportW:word):precord_outpacket; 89 | var 90 | i: Integer; 91 | outpacket:precord_outpacket; 92 | begin 93 | Result := nil; 94 | i := 0; 95 | while (i20 then begin 141 | mdht_outpackets.delete(i); 142 | freemem(outpacket,sizeof(record_outpacket)); 143 | continue; 144 | end; 145 | inc(i); 146 | end; 147 | 148 | end; 149 | 150 | procedure mdht_send(DestinationIP: Cardinal; DestinationPort: Word; packet_type:mdht_outpacket_type; targetSearch: Tmdhtsearch = nil); 151 | var 152 | outpacket:precord_outpacket; 153 | packet:precord_mdht_packet; 154 | begin 155 | if MDHT_udp_outpackets.count>1000 then exit; 156 | 157 | if packet_type<>packet_type_none then begin 158 | outpacket := allocMem(sizeof(record_outpacket)); 159 | outpacket^.time := thread_bittorrent.mdht_nowt; 160 | outpacket^.id := mdht_currentOutpacketIndex; 161 | outpacket^.ttype := packet_type; 162 | outpacket^.ipC := DestinationIP; 163 | outpacket^.portW := DestinationPort; 164 | outpacket^.targetsearch := targetSearch; 165 | 166 | mdht_outpackets.add(outpacket); 167 | 168 | inc(mdht_currentOutpacketIndex); 169 | if mdht_currentOutpacketIndex>=65534 then mdht_currentOutpacketIndex := 0; 170 | end; 171 | 172 | // delay sending 173 | packet := AllocMem(sizeof(record_mdht_packet)); 174 | packet.destIP := DestinationIP; 175 | packet.destPort := DestinationPort; 176 | SetLength(packet^.buffer,MDHT_len_tosend); 177 | move(MDHT_buffer,packet^.buffer[1],length(packet^.buffer)); 178 | MDHT_udp_outpackets.add(packet); 179 | 180 | end; 181 | 182 | procedure mdht_send(DestinationIP: Cardinal; DestinationPort:word); 183 | var 184 | packet:precord_mdht_packet; 185 | begin 186 | if MDHT_udp_outpackets.count>1000 then exit; 187 | 188 | // delay sending 189 | packet := AllocMem(sizeof(record_mdht_packet)); 190 | packet.destIP := DestinationIP; 191 | packet.destPort := DestinationPort; 192 | SetLength(packet^.buffer,MDHT_len_tosend); 193 | move(MDHT_buffer,packet^.buffer[1],length(packet^.buffer)); 194 | MDHT_udp_outpackets.add(packet); 195 | 196 | end; 197 | 198 | procedure mdht_flush_udp_packet; 199 | var 200 | packet:precord_mdht_packet; 201 | begin 202 | if MDHT_udp_outpackets.count=0 then exit; 203 | 204 | packet := MDHT_udp_outpackets[0]; 205 | MDHT_udp_outpackets.delete(0); 206 | 207 | MDHT_RemoteSendSin.sin_family := AF_INET; 208 | MDHT_RemoteSendSin.sin_port := packet^.destPort; 209 | MDHT_RemoteSendSin.sin_addr.s_addr := packet^.destIP; 210 | 211 | synsock.SendTo(MDHT_socket,packet^.buffer[1],length(packet^.buffer),0,@MDHT_RemoteSendSin,SizeOf(MDHT_RemoteSendSin)); 212 | 213 | SetLength(packet^.buffer,0); 214 | FreeMem(packet,sizeof(record_mdht_packet)); 215 | end; 216 | 217 | end. -------------------------------------------------------------------------------- /COMPILING.txt: -------------------------------------------------------------------------------- 1 | Requirements: 2 | 3 | Compiler/IDE: 4 | Borland Delphi 7 5 | http://www.borland.com 6 | 7 | 8 | Required Libraries: 9 | DSPack 10 | http://www.progdigy.com/modules.php?name=DSPack 11 | 12 | Tnt Delphi UNICODE Controls Project 13 | http://www.tntware.com/delphicontrols/unicode/ 14 | http://www.axolot.com/TNT/ 15 | http://www.yunqa.de/delphi/doku.php/products/tntunicodecontrols/index 16 | 17 | 18 | Additional VCL: 19 | ARES_VCLs 20 | http://sourceforge.net/projects/aresgalaxy/files/aresgalaxy/Ares_VCLs/Ares_VCLs_011713.zip/download 21 | 22 | 23 | 24 | 25 | Project's HomePage: 26 | http://aresgalaxy.sourceforge.net -------------------------------------------------------------------------------- /DHT/dhtUtils.pas: -------------------------------------------------------------------------------- 1 | { 2 | this file is part of Ares 3 | Aresgalaxy ( http://aresgalaxy.sourceforge.net ) 4 | 5 | This program is free software; you can redistribute it and/or 6 | modify it under the terms of the GNU General Public License 7 | as published by the Free Software Foundation; either 8 | version 2 of the License, or (at your option) any later version. 9 | 10 | This program is distributed in the hope that it will be useful, 11 | but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | GNU General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program; if not, write to the Free Software 17 | Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 18 | 19 | ***************************************************************** 20 | The following delphi code is based on Emule (0.46.2.26) Kad's implementation http://emule.sourceforge.net 21 | and KadC library http://kadc.sourceforge.net/ 22 | ***************************************************************** 23 | } 24 | 25 | { 26 | Description: 27 | misc fuctions 28 | } 29 | 30 | unit dhtUtils; 31 | 32 | interface 33 | 34 | uses 35 | Classes; 36 | 37 | function dht_packet_to_str(id:integer): string; 38 | 39 | implementation 40 | 41 | uses 42 | SysUtils, Windows, Classes2, DhtConsts; 43 | 44 | function dht_packet_to_str(id:integer): string; 45 | begin 46 | case id of 47 | CMD_DHT_BOOTSTRAP_REQ: 48 | Result := 'BOOTSTRAP_REQ'; // send bootstrap nodes 49 | CMD_DHT_BOOTSTRAP_RES: 50 | Result := 'BOOTSTRAP_RES'; 51 | 52 | CMD_DHT_HELLO_REQ: 53 | Result := 'HELLO_REQ'; // = $55; // ping pong 54 | CMD_DHT_HELLO_RES: 55 | Result := 'HELLO_RES'; // = $56; 56 | 57 | CMD_DHT_REQID: 58 | Result := 'REQID'; // = $60; // find nodes 59 | CMD_DHT_RESID: 60 | Result := 'RESID'; // = $61; 61 | CMD_DHT_REQID2: 62 | Result := 'REQID2'; // = $62; 63 | 64 | CMD_DHT_SEARCHKEY_REQ: 65 | Result := 'SEARCHKEY_REQ'; // = $70; // search and publish 66 | CMD_DHT_SEARCHKEY_RES: 67 | Result := 'SEARCHKEY_RES'; // = $71; 68 | 69 | CMD_DHT_PUBLISHKEY_REQ: 70 | Result := 'PUBLISHKEY_REQ'; // = $75; 71 | CMD_DHT_PUBLISHKEY_RES: 72 | Result := 'PUBLISHKEY_RES'; // = $76; 73 | 74 | CMD_DHT_SEARCHHASH_REQ: 75 | Result := 'SEARCHHASH_REQ'; // = $80; // search and publish 76 | CMD_DHT_SEARCHHASH_RES: 77 | Result := 'SEARCHHASH_RES'; // = $81; 78 | CMD_DHT_PUBLISHHASH_REQ: 79 | Result := 'PUBLISHHASH_REQ'; // = $82; 80 | CMD_DHT_PUBLISHHASH_RES: 81 | Result := 'PUBLISHHASH_RES'; // = $83; 82 | CMD_DHT_SEARCHPARTIALHASH_RES: 83 | Result := 'SEARCHPARTIALHASH_RES'; // = $84; 84 | 85 | CMD_DHT_IPREQ: 86 | Result := 'IPREQ'; // = $90; 87 | CMD_DHT_IPREP: 88 | Result := 'IPREP'; // = $91; 89 | CMD_DHT_CACHESREQ: 90 | Result := 'CACHESREQ'; // = $92; 91 | CMD_DHT_CACHESREP: 92 | Result := 'CACHESREP'; // = $93; 93 | CMD_DHT_FIREWALLCHECK: 94 | Result := 'FIREWALLCHECK'; // = $95; 95 | CMD_DHT_FIREWALLCHECKINPROG: 96 | Result := 'FIREWALLCHECKINPROG'; // = $96; 97 | CMD_DHT_FIREWALLCHECKRESULT: 98 | Result := 'FIREWALLCHECKRESULT'; //$97; 99 | else 100 | Result := 'Unknown ' + IntToStr(id); 101 | end; 102 | end; 103 | 104 | end. 105 | -------------------------------------------------------------------------------- /DHT/dhtconsts.pas: -------------------------------------------------------------------------------- 1 | { 2 | this file is part of Ares 3 | Aresgalaxy ( http://aresgalaxy.sourceforge.net ) 4 | 5 | This program is free software; you can redistribute it and/or 6 | modify it under the terms of the GNU General Public License 7 | as published by the Free Software Foundation; either 8 | version 2 of the License, or (at your option) any later version. 9 | 10 | This program is distributed in the hope that it will be useful, 11 | but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | GNU General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program; if not, write to the Free Software 17 | Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 18 | 19 | ***************************************************************** 20 | The following delphi code is based on Emule (0.46.2.26) Kad's implementation http://emule.sourceforge.net 21 | and KadC library http://kadc.sourceforge.net/ 22 | ***************************************************************** 23 | } 24 | 25 | { 26 | Description: 27 | DHT constants, Ares flavor byte and opcodes have been changed 28 | to avoid any problem with other existent DHT networks 29 | } 30 | 31 | unit dhtconsts; 32 | 33 | interface 34 | 35 | const 36 | OP_DHT_HEADER = $E9; // don't pollute Kad network 37 | OP_DHT_PACKEDPROT = $EA; 38 | 39 | OP_MDHT_HEADER = 100; 40 | OP_MDHT_ENCRYPTED_HEADER = 65; 41 | OP_MDHT_UKNOWN = 33; 42 | 43 | 44 | CMD_DHT_BOOTSTRAP_REQ = $50; // send bootstrap nodes 45 | CMD_DHT_BOOTSTRAP_RES = $51; 46 | 47 | CMD_DHT_HELLO_REQ = $55; // ping pong 48 | CMD_DHT_HELLO_RES = $56; 49 | 50 | CMD_DHT_REQID = $60; // find nodes 51 | CMD_DHT_RESID = $61; 52 | CMD_DHT_REQID2 = $62; 53 | 54 | CMD_DHT_SEARCHKEY_REQ = $70; // search and publish 55 | CMD_DHT_SEARCHKEY_RES = $71; 56 | CMD_DHT_PUBLISHKEY_REQ = $75; 57 | CMD_DHT_PUBLISHKEY_RES = $76; 58 | 59 | CMD_DHT_SEARCHHASH_REQ = $80; // search and publish 60 | CMD_DHT_SEARCHHASH_RES = $81; 61 | CMD_DHT_PUBLISHHASH_REQ = $82; 62 | CMD_DHT_PUBLISHHASH_RES = $83; 63 | CMD_DHT_SEARCHPARTIALHASH_RES = $84; 64 | 65 | CMD_DHT_IPREQ = $90; 66 | CMD_DHT_IPREP = $91; 67 | CMD_DHT_CACHESREQ = $92; 68 | CMD_DHT_CACHESREP = $93; 69 | CMD_DHT_FIREWALLCHECK = $95; 70 | CMD_DHT_FIREWALLCHECKINPROG = $96; 71 | CMD_DHT_FIREWALLCHECKRESULT = $97; 72 | 73 | DHTFIREWALLRESULT_FAILEDCONNECTION =0; 74 | DHTFIREWALLRESULT_CONNECTED =1; 75 | 76 | // FIND_ID values (parameter) left unchanged to kademlia values 77 | ARES_DHT_FIND_VALUE = $02; 78 | ARES_DHT_STORE = $04; 79 | ARES_DHT_FIND_NODE = $0B; 80 | 81 | 82 | 83 | // max number of non-responses before a node is assumed dead or offline 84 | DHT_MAX_SOURCES_HASH = 200; 85 | DHT_MAX_PARTIALSOURCES_HASH = 100; 86 | DHT_MAX_RETURNEDKEYWORDFILES = 200; 87 | CONTACT_FILE_LIMIT = 5000; 88 | DHT_MAX_SHARED_KEYWORDFILES = 50000; 89 | DHT_MAX_SHARED_HASHFILES = 50000; 90 | DHT_REPUBLISHHASHTIMEms = 10800000; // 3 hours (milliseconds) 91 | DHT_REPUBLISHKEYTIMEms = 21600000; // 6 hours (milliseconds) 92 | 93 | MAX_DHT_OUTSEARCHES = 6; 94 | MAX_DHT_HASH_OUTPUBLISHREQS = 3; 95 | MAX_DHT_HASH_SEARCHREQS = 2; 96 | MAX_DHT_KEY_OUTPUBLISHREQS = 3; 97 | SEARCHTOLERANCE = 16777216; 98 | K10 = 10; 99 | KPINGABLE = 4; 100 | KBASE = 4; 101 | KK = 5; 102 | ALPHA_QUERY = 3; 103 | LOG_BASE_EXPONENT = 5; 104 | HELLO_TIMEOUT = 20; 105 | SEARCH_JUMPSTART = 1; 106 | SEARCH_LIFETIME = 45; 107 | SEARCHKEYWORD_LIFETIME = 45; 108 | SEARCHNODE_LIFETIME = 45; 109 | SEARCHNODECOMP_LIFETIME = 10; 110 | SEARCHSTOREFILE_LIFETIME = 140; 111 | SEARCHSTOREKEYWORD_LIFETIME = 140; 112 | SEARCHFINDSOURCE_LIFETIME = 45; 113 | SEARCHFILE_TOTAL = 300; 114 | SEARCHKEYWORD_TOTAL = 300; 115 | SEARCHSTOREFILE_TOTAL = 10; 116 | SEARCHSTOREKEYWORD_TOTAL = 10; 117 | SEARCHNODECOMP_TOTAL = 10; 118 | SEARCHFINDSOURCE_TOTAL = 20; 119 | DHT_BOOTSTRAP_INTERVAL = 15; 120 | 121 | TAG_ID_DHT_STATS = 0; 122 | TAG_ID_DHT_TITLE = 1; 123 | TAG_ID_DHT_ARTIST = 2; 124 | TAG_ID_DHT_ALBUM = 3; 125 | TAG_ID_DHT_CATEGORY = 4; 126 | TAG_ID_DHT_LANGUAGE = 5; 127 | TAG_ID_DHT_DATE = 6; 128 | TAG_ID_DHT_PARAM2 = 7; 129 | TAG_ID_DHT_COMMENTS = 8; 130 | TAG_ID_DHT_URL = 9; 131 | TAG_ID_DHT_FILENAME = 10; 132 | TAG_ID_DHT_KEYWGENRE = 11; 133 | 134 | 135 | 136 | SECOND=1; 137 | MINUTE=60; 138 | HOUR=3600; 139 | 140 | DHT_DISCONNECTDELAY = 1200; //20 mins 141 | 142 | implementation 143 | 144 | end. 145 | -------------------------------------------------------------------------------- /DHT/dhtsocket.pas: -------------------------------------------------------------------------------- 1 | { 2 | this file is part of Ares 3 | Aresgalaxy ( http://aresgalaxy.sourceforge.net ) 4 | 5 | This program is free software; you can redistribute it and/or 6 | modify it under the terms of the GNU General Public License 7 | as published by the Free Software Foundation; either 8 | version 2 of the License, or (at your option) any later version. 9 | 10 | This program is distributed in the hope that it will be useful, 11 | but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | GNU General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program; if not, write to the Free Software 17 | Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 18 | 19 | ***************************************************************** 20 | The following delphi code is based on Emule (0.46.2.26) Kad's implementation http://emule.sourceforge.net 21 | and KadC library http://kadc.sourceforge.net/ 22 | ***************************************************************** 23 | } 24 | 25 | { 26 | Description: 27 | UDP socket code 28 | } 29 | 30 | unit dhtsocket; 31 | 32 | interface 33 | 34 | uses 35 | Classes, SysUtils, Windows, Dhtconsts, SynSock, DhtTypes; 36 | 37 | procedure DHT_send(DestinationIP: Cardinal; DestinationPort: Word; compress:boolean=false; priority:boolean=false); 38 | procedure DHT_sendMyDetails(opcode: Byte; ip: Cardinal; port:word); 39 | procedure DHT_SendBackPublishHashAck(ip: Cardinal; port: Word; load: Byte); 40 | procedure DHT_SendCacheCheck(ip: Cardinal; port:word); 41 | procedure DHT_flush_outpackets; 42 | 43 | implementation 44 | 45 | uses 46 | vars_global, zlib, thread_dht, helper_ipfunc; 47 | 48 | 49 | procedure DHT_SendBackPublishHashAck(ip: Cardinal; port: Word; load: Byte); 50 | begin 51 | DHT_buffer[1] := CMD_DHT_PUBLISHHASH_RES; 52 | DHT_buffer[22] := load; 53 | DHT_len_tosend := 23; 54 | DHT_send(ip,port,false); 55 | end; 56 | 57 | procedure DHT_SendCacheCheck(ip: Cardinal; port:word); 58 | begin 59 | DHT_buffer[1] := CMD_DHT_CACHESREQ; 60 | DHT_buffer[2] := 0; 61 | DHT_len_tosend := 3; 62 | DHT_send(ip,port,false); 63 | thread_dht.DHT_CacheCheckIp := ip; 64 | end; 65 | 66 | 67 | procedure DHT_sendMyDetails(opcode: Byte; ip: Cardinal; port:word); 68 | begin 69 | DHT_buffer[1] := opcode; 70 | 71 | move(DHTme128[0],DHT_buffer[2],4); 72 | move(DHTme128[1],DHT_buffer[6],4); 73 | move(DHTme128[2],DHT_buffer[10],4); 74 | move(DHTme128[3],DHT_buffer[14],4); 75 | 76 | //my_ipKadOrder := synsock.ntohl(vars_global.localipC); 77 | move(vars_global.localipC,DHT_buffer[18],4); 78 | move(vars_global.myport,DHT_buffer[22],2); 79 | move(vars_global.myport,DHT_buffer[24],2); 80 | DHT_buffer[26] := 0; 81 | DHT_len_tosend := 27; 82 | 83 | DHT_send(ip, port, false, true); 84 | end; 85 | 86 | procedure DHT_send(DestinationIP: Cardinal; DestinationPort: Word; compress:boolean=false; priority:boolean=false); 87 | var 88 | buff: Pointer; 89 | outsize: Integer; 90 | outpacket:precord_dht_outpacket; 91 | begin 92 | if DHT_len_tosend<1 then exit; 93 | if DHT_outpackets.count>2000 then exit; 94 | 95 | if compress then begin 96 | 97 | DHT_buffer[0] := OP_DHT_PACKEDPROT; 98 | 99 | try 100 | ZCompress(@DHT_Buffer[2],DHT_len_tosend-2,buff,outsize); 101 | Move(buff^, DHT_Buffer[2], outsize); 102 | DHT_len_tosend := outsize+2; 103 | FreeMem(buff,outsize); 104 | except 105 | exit; 106 | end; 107 | end else DHT_buffer[0] := OP_DHT_HEADER; 108 | 109 | if DHT_len_tosend<1 then exit; 110 | 111 | 112 | // if priority then begin 113 | DHT_RemoteSin.sin_family := AF_INET; 114 | DHT_RemoteSin.sin_port := synsock.htons(DestinationPort); 115 | DHT_RemoteSin.sin_addr.s_addr := DestinationIP; 116 | synsock.SendTo(DHT_socket,DHT_buffer,DHT_len_tosend,0,@DHT_RemoteSin,SizeOf(DHT_RemoteSin)); 117 | exit; 118 | // end; 119 | 120 | while (DHT_outpackets.count>10) do begin 121 | DHT_flush_outpackets; 122 | end; 123 | 124 | outpacket := AllocMem(sizeof(record_dht_outpacket)); 125 | outpacket^.destIP := DestinationIP; 126 | outpacket^.destPort := synsock.htons(DestinationPort); 127 | 128 | SetLength(outpacket^.buffer,DHT_len_tosend); 129 | move(DHT_buffer,outpacket^.buffer[1],length(outpacket^.buffer)); 130 | 131 | DHT_outpackets.add(outpacket); 132 | 133 | // DHT_RemoteSin.sin_family := AF_INET; 134 | // DHT_RemoteSin.sin_port := synsock.htons(DestinationPort); 135 | // DHT_RemoteSin.sin_addr.s_addr := DestinationIP; 136 | //synsock.SendTo(DHT_socket,DHT_buffer,DHT_len_tosend,0,@DHT_RemoteSin,SizeOf(DHT_RemoteSin)); 137 | end; 138 | 139 | procedure DHT_flush_outpackets; 140 | var 141 | outpacket:precord_dht_outpacket; 142 | begin 143 | if DHT_outpackets.count=0 then exit; 144 | 145 | 146 | outpacket := DHT_outpackets[0]; 147 | DHT_outpackets.delete(0); 148 | 149 | DHT_RemoteSin.sin_family := AF_INET; 150 | DHT_RemoteSin.sin_port := outpacket^.destPort; 151 | DHT_RemoteSin.sin_addr.s_addr := outpacket^.destIP; 152 | 153 | synsock.SendTo(DHT_socket,outpacket^.buffer[1],length(outpacket^.buffer),0,@DHT_RemoteSin,SizeOf(DHT_RemoteSin)); 154 | 155 | 156 | SetLength(outpacket^.buffer,0); 157 | FreeMem(outpacket,sizeof(record_dht_outpacket)); 158 | end; 159 | 160 | end. 161 | -------------------------------------------------------------------------------- /DHT/dhttypes.pas: -------------------------------------------------------------------------------- 1 | { 2 | this file is part of Ares 3 | Aresgalaxy ( http://aresgalaxy.sourceforge.net ) 4 | 5 | This program is free software; you can redistribute it and/or 6 | modify it under the terms of the GNU General Public License 7 | as published by the Free Software Foundation; either 8 | version 2 of the License, or (at your option) any later version. 9 | 10 | This program is distributed in the hope that it will be useful, 11 | but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | GNU General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program; if not, write to the Free Software 17 | Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 18 | 19 | ***************************************************************** 20 | The following delphi code is based on Emule (0.46.2.26) Kad's implementation http://emule.sourceforge.net 21 | and KadC library http://kadc.sourceforge.net/ 22 | ***************************************************************** 23 | } 24 | 25 | { 26 | Description: 27 | DHT types 28 | } 29 | 30 | unit DhtTypes; 31 | 32 | interface 33 | 34 | uses 35 | Classes, Classes2, Int128, SysUtils, Contnrs, DhtUtils, Windows, Keywfunc, 36 | Blcksock; 37 | 38 | type 39 | precord_DHT_keywordFilePublishReq=^record_DHT_keywordFilePublishReq; 40 | record_DHT_keywordFilePublishReq=record 41 | keyW: string; 42 | crc: Word; // last two bytes of 20 byte sha1 43 | fileHashes: TMyStringList; 44 | end; 45 | 46 | precord_dht_source=^record_dht_source; 47 | record_dht_source=record 48 | ip: Cardinal; 49 | raw: string; 50 | lastSeen: Cardinal; 51 | prev,next:precord_dht_source; 52 | end; 53 | 54 | precord_dht_outpacket=^record_dht_outpacket; 55 | record_dht_outpacket=record 56 | destIP: Cardinal; 57 | destPort: Word; 58 | buffer: string; 59 | end; 60 | 61 | precord_DHT_firewallcheck=^record_DHT_firewallcheck; 62 | record_DHT_firewallcheck=record 63 | RemoteIp: Cardinal; 64 | RemoteUDPPort: Word; 65 | RemoteTCPPort: Word; 66 | started: Cardinal; 67 | sockt:HSocket; 68 | end; 69 | 70 | precord_DHT_hash=^record_dht_hash; 71 | record_dht_hash=record 72 | hashValue: array [0..19] of Byte; 73 | crc: Word; 74 | count: Word; // number of items 75 | lastSeen: Cardinal; 76 | firstSource:precord_dht_source; 77 | prev,next:precord_dht_hash; 78 | end; 79 | 80 | precord_DHT_hashfile=^record_DHT_hashfile; 81 | record_DHT_hashfile=record 82 | HashValue: array [0..19] of Byte; 83 | end; 84 | 85 | precord_dht_storedfile=^record_dht_storedfile; 86 | record_dht_storedfile=record 87 | hashValue: array [0..19] of Byte; 88 | crc: Word; 89 | 90 | amime: Byte; 91 | ip: Cardinal; //last publish source is available immediately 92 | port: Word; 93 | 94 | count: Word; 95 | lastSeen: Cardinal; 96 | 97 | fsize: Int64; 98 | param1,param3: Cardinal; 99 | info: string; 100 | 101 | numKeywords: Byte; 102 | keywords:PWordsArray; 103 | 104 | prev,next:precord_dht_storedfile; 105 | end; 106 | 107 | PDHTKeyWordItem=^TDHTKeyWordItem; 108 | TDHTKeywordItem = packed record 109 | share : precord_dht_storedfile; 110 | prev, next: PDHTKeywordItem; 111 | end; 112 | 113 | PDHTKeyword = ^TDHTKeyword; 114 | TDHTKeyword = packed record // structure that manages one keyword 115 | keyword : array of char; // keyword 116 | count : cardinal; 117 | crc : word; 118 | firstitem : PDHTKeywordItem; // pointer to first full item 119 | prev, next: PDHTKeyword; // pointer to previous and next PKeyword items in global list 120 | end; 121 | 122 | type 123 | tdhtsearchtype=( 124 | UNDEFINED, 125 | NODE, 126 | NODECOMPLETE, 127 | KEYWORD, 128 | STOREFILE, 129 | STOREKEYWORD, 130 | FINDSOURCE 131 | ); 132 | 133 | 134 | implementation 135 | 136 | end. 137 | -------------------------------------------------------------------------------- /Drag_N_Drop.pas: -------------------------------------------------------------------------------- 1 | { 2 | this file is part of Ares 3 | Aresgalaxy ( http://aresgalaxy.sourceforge.net ) 4 | 5 | This program is free software; you can redistribute it and/or 6 | modify it under the terms of the GNU General Public License 7 | as published by the Free Software Foundation; either 8 | version 2 of the License, or (at your option) any later version. 9 | 10 | This program is distributed in the hope that it will be useful, 11 | but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | GNU General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program; if not, write to the Free Software 17 | Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 18 | } 19 | 20 | { 21 | Description: 22 | drag&drop helper code 23 | } 24 | 25 | unit Drag_N_Drop; 26 | 27 | interface 28 | 29 | uses 30 | Windows,ares_types,SysUtils; 31 | 32 | 33 | type 34 | 35 | {$EXTERNALSYM HDROP} 36 | HDROP = Longint; 37 | PPWideChar = ^PWideChar; 38 | 39 | TDropGotFileProc = function(FileName : wideString;count : integer): Boolean; 40 | 41 | function DropPoint(dropmsg : TWMDropFiles) : TPoint; 42 | function DropFileCount(dropmsg : TWMDropFiles) : integer; 43 | function DropGetFile(dropmsg : TWMDropFiles) : widestring; overload; 44 | function DropGetFile(dropmsg : TWMDropFiles;index : integer) : widestring; overload; 45 | function DropGetFileExt(Dropmsg : TWMDropFiles) : string;overload; 46 | function DropGetFileExt(Dropmsg : TWMDropFiles; index : integer) : string;overload; 47 | function DropDifferentExt(Dropmsg : TWMDropFiles) : Boolean; 48 | procedure DropGetFiles(dropmsg : TWMDropFiles;GotFileProc : TDropGotFileProc);overload; 49 | procedure Dropped(dropmsg : TWMDropFiles); 50 | 51 | 52 | {$EXTERNALSYM DragQueryPoint} 53 | function DragQueryPoint(Drop: HDROP; var Point: TPoint): BOOL; stdcall; 54 | {$EXTERNALSYM DragQueryFile} 55 | function DragQueryFile(Drop: HDROP; FileIndex: UINT; FileName: PChar; cb: UINT): UINT; stdcall; 56 | {$EXTERNALSYM DragQueryFileW} 57 | function DragQueryFileW(Drop: HDROP; FileIndex: UINT; FileName: PWideChar; cb: UINT): UINT; stdcall; 58 | {$EXTERNALSYM DragFinish} 59 | procedure DragFinish(Drop: HDROP); stdcall; 60 | 61 | implementation 62 | 63 | function DragQueryPoint; external 'shell32.dll' name 'DragQueryPoint'; 64 | function DragQueryFile; external 'shell32.dll' name 'DragQueryFileA'; 65 | function DragQueryFileW; external 'shell32.dll' name 'DragQueryFileW'; 66 | procedure DragFinish; external 'shell32.dll' name 'DragFinish'; 67 | 68 | function DropPoint(dropmsg : TWMDropFiles) : TPoint; 69 | Begin 70 | DragQueryPoint(dropmsg.drop,result); 71 | end; 72 | 73 | function DropFileCount(dropmsg : TWMDropFiles) : integer; 74 | Begin 75 | Result := DragQueryFile(dropmsg.drop,$FFFFFFFF,nil,0); 76 | end; 77 | 78 | function DropGetFile(dropmsg : TWMDropFiles) : widestring; overload; 79 | Begin 80 | Result := DropGetfile(dropmsg,0); 81 | end; 82 | 83 | function DropGetFileExt(Dropmsg : TWMDropFiles) : string; 84 | begin 85 | Result := ExtractFileExt(DropGetFile(Dropmsg)); 86 | end; 87 | 88 | function DropGetFileExt(Dropmsg : TWMDropFiles; index : integer) : string; 89 | begin 90 | Result := ExtractFileExt(DropGetFile(Dropmsg,index)); 91 | end; 92 | 93 | function DropDifferentExt(Dropmsg : TWMDropFiles) : Boolean; 94 | var 95 | i : integer; 96 | tmp : string; 97 | Begin 98 | Result := False; 99 | tmp := DropGetFileExt(Dropmsg); 100 | for i := 1 to DropFileCount(dropmsg)-1 do 101 | if tmp <> DropGetFileExt(Dropmsg,i) then 102 | begin 103 | Result := True; 104 | exit; 105 | end; 106 | end; 107 | 108 | function DropGetFile(dropmsg : TWMDropFiles; index : integer) : widestring; overload; 109 | var 110 | p : Pwidechar; 111 | Begin 112 | getmem(p,1024); 113 | DragQueryFileW(dropmsg.drop,index,p,1024); 114 | Result := p; 115 | freemem(p,1024); 116 | end; 117 | 118 | 119 | procedure DropGetFiles(dropmsg : TWMDropFiles; GotFileProc : TDropGotFileProc);overload; 120 | var 121 | i : integer; 122 | Begin 123 | for i := 0 to DropFileCount(dropmsg)-1 do 124 | if not GotfileProc(DropGetFile(dropmsg,i),i) then exit; 125 | end; 126 | 127 | procedure Dropped(dropmsg : TWMDropFiles); 128 | begin 129 | Dragfinish(dropmsg.drop); 130 | end; 131 | 132 | end. 133 | -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | Ares version 1.9.6+ uses AsyncEx DirectX filter 0.92 made by Martin Offenwanger 2 | Mail: coder@dsplayer.de 3 | Web: http://www.dsplayer.de 4 | 5 | AAC+ Internet Radio Support thanks to LibFaad2 6 | Web: http://www.audiocoding.com/ -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # AresGalaxy 2 | Fork of the [Ares Galaxy project](https://sourceforge.net/projects/aresgalaxy/) 3 | 4 | For copyright and license information please see the original project. 5 | 6 | ## Background of this fork 7 | The original source code is not available in a modern source code repository with revision control. Also it is meant for an old Delphi version. For purpose of training, I decided to fork and modernize this project. 8 | 9 | The code here is not meant to be complete or fully working. It's work in progress. Maybe someday it will be complete and fully running, compiled with a recent compiler. But probably not. 10 | 11 | -------------------------------------------------------------------------------- /Test/MainUnit.dfm: -------------------------------------------------------------------------------- 1 | object Form3: TForm3 2 | Left = 0 3 | Top = 0 4 | Caption = 'Form3' 5 | ClientHeight = 423 6 | ClientWidth = 860 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | PixelsPerInch = 96 15 | TextHeight = 13 16 | end 17 | -------------------------------------------------------------------------------- /Test/MainUnit.pas: -------------------------------------------------------------------------------- 1 | unit MainUnit; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs; 8 | 9 | type 10 | TForm3 = class(TForm) 11 | private 12 | { Private-Deklarationen } 13 | public 14 | { Public-Deklarationen } 15 | end; 16 | 17 | var 18 | Form3: TForm3; 19 | 20 | implementation 21 | 22 | {$R *.dfm} 23 | 24 | end. 25 | 26 | -------------------------------------------------------------------------------- /Test/Test.dpr: -------------------------------------------------------------------------------- 1 | program Test; 2 | 3 | uses 4 | Vcl.Forms, 5 | MainUnit in 'MainUnit.pas' {Form3}, 6 | BDecode in '..\BitTorrent\BDecode.pas', 7 | classes2 in '..\classes2.pas', 8 | dht_consts in '..\BitTorrent\dht_consts.pas', 9 | dht_search in '..\BitTorrent\dht_search.pas', 10 | dht_searchManager in '..\BitTorrent\dht_searchManager.pas', 11 | dht_socket in '..\BitTorrent\dht_socket.pas', 12 | dht_zones in '..\BitTorrent\dht_zones.pas', 13 | hashes in '..\BitTorrent\hashes.pas', 14 | thread_bitTorrent in '..\BitTorrent\thread_bitTorrent.pas', 15 | torrentparser in '..\BitTorrent\torrentparser.pas', 16 | helper_datetime in '..\helper_datetime.pas', 17 | const_ares in '..\const_ares.pas', 18 | dht_int160 in '..\BitTorrent\dht_int160.pas', 19 | helper_strings in '..\helper_strings.pas', 20 | ares_types in '..\ares_types.pas', 21 | ares_types_root in '..\ares_types_root.pas', 22 | helper_urls in '..\helper_urls.pas', 23 | helper_unicode in '..\helper_unicode.pas', 24 | helpeR_ipfunc in '..\helpeR_ipfunc.pas', 25 | helper_crypt in '..\helper_crypt.pas', 26 | securehash in '..\securehash.pas', 27 | umediar in '..\umediar.pas', 28 | helper_diskio in '..\helper_diskio.pas'; 29 | 30 | {$R *.res} 31 | 32 | begin 33 | Application.Initialize; 34 | Application.MainFormOnTaskbar := True; 35 | Application.CreateForm(TForm3, Form3); 36 | Application.Run; 37 | end. 38 | 39 | -------------------------------------------------------------------------------- /Test/Test.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CWBudde/AresGalaxy/b6136fd50c80f73be3115b315bb15bbbf9d1b528/Test/Test.res -------------------------------------------------------------------------------- /VCLs/AresCp.dpk: -------------------------------------------------------------------------------- 1 | package AresCp; 2 | 3 | {$R *.res} 4 | {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} 5 | {$ALIGN 8} 6 | {$ASSERTIONS OFF} 7 | {$BOOLEVAL OFF} 8 | {$DEBUGINFO OFF} 9 | {$EXTENDEDSYNTAX ON} 10 | {$IMPORTEDDATA ON} 11 | {$IOCHECKS ON} 12 | {$LOCALSYMBOLS OFF} 13 | {$LONGSTRINGS ON} 14 | {$OPENSTRINGS ON} 15 | {$OPTIMIZATION OFF} 16 | {$OVERFLOWCHECKS OFF} 17 | {$RANGECHECKS OFF} 18 | {$REFERENCEINFO OFF} 19 | {$SAFEDIVIDE OFF} 20 | {$STACKFRAMES ON} 21 | {$TYPEDADDRESS OFF} 22 | {$VARSTRINGCHECKS ON} 23 | {$WRITEABLECONST OFF} 24 | {$MINENUMSIZE 1} 25 | {$IMAGEBASE $400000} 26 | {$DEFINE DEBUG} 27 | {$ENDIF IMPLICITBUILDING} 28 | {$IMPLICITBUILD ON} 29 | 30 | requires 31 | rtl, 32 | vcl, 33 | designide; 34 | 35 | contains 36 | BGImPanel in 'BGImPanel.pas', 37 | CometBtnEdit in 'CometBtnEdit.pas', 38 | CometHint in 'CometHint.pas', 39 | CometPageView in 'CometPageView.pas', 40 | CometTopicPnl in 'CometTopicPnl.pas', 41 | CometTrack in 'CometTrack.pas', 42 | CometTrees in 'CometTrees.pas', 43 | CometTreesReg in 'CometTreesReg.pas', 44 | CometVerInfo in 'CometVerInfo.pas', 45 | FolderBrowse in 'FolderBrowse.pas', 46 | mPlayerPanel in 'mPlayerPanel.pas', 47 | uTrayIcon in 'uTrayIcon.pas', 48 | VCHeaderPopup in 'VCHeaderPopup.pas', 49 | WinSplit in 'WinSplit.pas', 50 | XPbutton in 'XPbutton.pas', 51 | XPMan in 'XPMan.pas'; 52 | 53 | end. 54 | -------------------------------------------------------------------------------- /VCLs/AresCp.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {7B2E3D7F-743C-44AA-8919-0F2D70A7F93C} 4 | arescp.dpk 5 | True 6 | Debug 7 | 1 8 | Package 9 | VCL 10 | 18.3 11 | Win32 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | Base 29 | true 30 | 31 | 32 | true 33 | Base 34 | true 35 | 36 | 37 | false 38 | false 39 | false 40 | false 41 | false 42 | 00400000 43 | true 44 | true 45 | arescp 46 | false 47 | 0 48 | false 49 | 0 50 | Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace) 51 | 1031 52 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName= 53 | 54 | 55 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 56 | Debug 57 | true 58 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) 59 | 1033 60 | arescp_Icon.ico 61 | vcl;rtl;$(DCC_UsePackage) 62 | 63 | 64 | arescp_Icon.ico 65 | vcl;rtl;$(DCC_UsePackage) 66 | 67 | 68 | RELEASE;$(DCC_Define) 69 | 0 70 | false 71 | 0 72 | 73 | 74 | DEBUG;$(DCC_Define) 75 | false 76 | true 77 | 78 | 79 | 80 | MainSource 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | 98 | 99 | 100 | 101 | 102 | Cfg_2 103 | Base 104 | 105 | 106 | Base 107 | 108 | 109 | Cfg_1 110 | Base 111 | 112 | 113 | 114 | Delphi.Personality.12 115 | Package 116 | 117 | 118 | 119 | arescp.dpk 120 | 121 | 122 | 123 | False 124 | False 125 | False 126 | True 127 | False 128 | 129 | 130 | 12 131 | 132 | 133 | 134 | 135 | -------------------------------------------------------------------------------- /VCLs/CometTopicPnl.pas: -------------------------------------------------------------------------------- 1 | unit CometTopicPnl; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Graphics, ExtCtrls, Classes, Controls, Messages, Forms; 7 | 8 | type 9 | TCmtPaintEvent = procedure(Sender: TObject; Acanvas: TCanvas; capt: WideString; var ShouldContinue: Boolean) of object; 10 | TCmtUrlClickEvent = procedure(Sender: TObject; const URLText: String; Button: TMouseButton) of object; 11 | 12 | TCometTopicPnl = class(TPanel) 13 | protected 14 | FCaptTop: Integer; 15 | FCapt: WideString; 16 | FCaptLeft: Integer; 17 | FOnPaint: TCmtPaintEvent; 18 | procedure invalidate_caption; 19 | procedure WMEraseBkgnd(var Msg: TMessage); message WM_ERASEBKGND; 20 | procedure paint; override; 21 | procedure SetCapt(value: WideString); 22 | public 23 | constructor Create(AComponent: TComponent); override; 24 | published 25 | property Capt: WideString read FCapt write setcapt; 26 | property Canvas; 27 | property CaptionLeft: Integer read FCaptLeft write FCaptLeft default 0; 28 | property CaptTop: Integer read FCaptTop write FCaptTop; 29 | 30 | property OnPaint: TCmtPaintEvent read FOnPaint write FOnPaint; 31 | end; 32 | 33 | TCometPlayerPanel = class(TCometTopicPnl) 34 | protected 35 | FUrl: string; 36 | FUrlCaption: WideString; 37 | FOnUrlClick: TCmtUrlClickEvent; 38 | FUrlPosx, FUrlWidth, FUrlheight: Integer; 39 | procedure paint; override; 40 | procedure SetUrl(const valueUrl: string); 41 | procedure SetCaptionUrl(const valueCaption: WideString); 42 | procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; 43 | procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; 44 | public 45 | procedure Invalidate_url; 46 | published 47 | property Url: string read FUrl write SetUrl; 48 | property CaptionUrl: WideString read FUrlCaption write SetCaptionUrl; 49 | property OnUrlClick: TCmtUrlClickEvent read FOnUrlClick write FOnUrlClick; 50 | end; 51 | 52 | procedure Register; 53 | 54 | implementation 55 | 56 | ////////// TCometPlayerPanel 57 | procedure TCometPlayerPanel.paint; 58 | begin 59 | inherited paint; 60 | 61 | if ((length(FUrl)>0) and (length(FUrlCaption)>0)) then 62 | Invalidate_url; 63 | end; 64 | 65 | procedure TCometPlayerPanel.SetUrl(const valueUrl: string); 66 | begin 67 | FUrl := valueUrl; 68 | 69 | if length(FUrl)=0 then 70 | begin 71 | FUrlPosx := 0; 72 | FUrlWidth := 0; 73 | end; 74 | 75 | Invalidate; 76 | end; 77 | 78 | procedure TCometPlayerPanel.SetCaptionUrl(const valueCaption: WideString); 79 | begin 80 | FUrlCaption := valueCaption; 81 | Invalidate; 82 | end; 83 | 84 | procedure TCometPlayerPanel.Invalidate_url; 85 | var 86 | r: TRect; 87 | Size: TSize; 88 | begin 89 | Canvas.Font.Name := Font.Name; 90 | Canvas.Font.Size := Font.Size; 91 | Canvas.Font.Style := Font.Style; 92 | Canvas.Font.Color := Font.Color; 93 | Size.cX := 0; 94 | Size.cY := 0; 95 | Windows.GetTextExtentPointW(Canvas.Handle, PWideChar(FCapt), Length(FCapt), Size); 96 | 97 | FUrlPosx := Size.cx+CaptionLeft+10; 98 | 99 | Canvas.Font.Style := [fsUnderline]; 100 | Canvas.Font.Color := clblue; 101 | Size.cX := 0; 102 | Size.cY := 0; 103 | Windows.GetTextExtentPointW(Canvas.Handle, PWideChar(furlCaption), Length(furlCaption), Size); 104 | 105 | FUrlWidth := Size.cx; 106 | FUrlheight := Size.cy; 107 | 108 | r.left := FUrlPosx; 109 | r.right := clientwidth-3; 110 | r.top := 0; 111 | r.bottom := clientHeight; 112 | Windows.ExtTextOutW(Canvas.Handle, FUrlPosx, FCaptTop, ETO_CLIPPED, @R, 113 | PWideChar(FUrlCaption),Length(FUrlCaption), nil); 114 | end; 115 | 116 | procedure TCometPlayerPanel.MouseMove(Shift: TShiftState; X, Y: Integer); 117 | begin 118 | if ((x>=FUrlPosx) and 119 | (x<=FUrlPosx+FUrlWidth) and 120 | (y>=FCaptTop) and 121 | (y<=FCaptTop+FUrlheight)) then cursor := crHandpoint 122 | else cursor := crDefault; 123 | 124 | inherited; 125 | end; 126 | 127 | procedure TCometPlayerPanel.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 128 | var 129 | Btn: TMouseButton; 130 | begin 131 | if not assigned(FOnUrlClick) then 132 | begin 133 | inherited; 134 | exit; 135 | end; 136 | 137 | if ((x>=FUrlPosx) and 138 | (x<=FUrlPosx+FUrlWidth) and 139 | (y>=FCaptTop) and 140 | (y<=FCaptTop+FUrlheight)) then 141 | FOnUrlClick(self,FUrl,Btn) 142 | else 143 | inherited; 144 | end; 145 | 146 | 147 | //////// TCometTopicPnl 148 | 149 | constructor TCometTopicPnl.Create(AComponent: TComponent); 150 | begin 151 | inherited Create(AComponent); 152 | ControlStyle := ControlStyle + [csOpaque]; 153 | Color := clBtnface; 154 | doublebuffered := True; 155 | FCaptTop := 4; 156 | end; 157 | 158 | procedure TCometTopicPnl.paint; 159 | var 160 | ShouldContinue: Boolean; 161 | begin 162 | inherited paint; 163 | 164 | Canvas.pen.Color := Color; 165 | Canvas.brush.Color := Color; //nessun override di colore! 166 | if ((bevelinner=bvnone) and (bevelouter=bvnone)) then 167 | Canvas.rectangle(0,0,width,height) 168 | else 169 | Canvas.rectangle(2,2,width-2,height-2); 170 | 171 | if Assigned(FOnPaint) then 172 | begin 173 | FOnPaint(self,Canvas,FCapt,ShouldContinue); 174 | if not ShouldContinue then 175 | exit; 176 | end; 177 | 178 | if length(FCapt) = 0 then 179 | exit; 180 | 181 | invalidate_caption; 182 | end; 183 | 184 | procedure TCometTopicPnl.invalidate_caption; 185 | var 186 | r: TRect; 187 | begin 188 | Canvas.Font.Name := Font.Name; 189 | Canvas.Font.Size := Font.Size; 190 | Canvas.Font.Style := Font.Style; 191 | Canvas.Font.Color := Font.Color; 192 | 193 | r.left := FCaptLeft; 194 | r.right := width - 3; 195 | r.top := 0; 196 | r.bottom := Height; 197 | 198 | SetBkMode(Canvas.Handle, TRANSPARENT); 199 | Windows.ExtTextOutW(Canvas.Handle, FCaptLeft + 4, FCaptTop, ETO_CLIPPED, @R, 200 | PWideChar(FCapt),Length(FCapt), nil); 201 | end; 202 | 203 | procedure TCometTopicPnl.SetCapt(Value: WideString); 204 | begin 205 | FCapt := value; 206 | Invalidate; 207 | end; 208 | 209 | procedure TCometTopicPnl.WMEraseBkgnd(var Msg: TMessage); //reduce flicker; 210 | begin 211 | msg.result := 1; 212 | end; 213 | 214 | procedure Register; 215 | begin 216 | RegisterComponents('Comet', [TCometTopicPnl, TCometPlayerPanel]); 217 | end; 218 | 219 | 220 | end. 221 | -------------------------------------------------------------------------------- /VCLs/CometTrees.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CWBudde/AresGalaxy/b6136fd50c80f73be3115b315bb15bbbf9d1b528/VCLs/CometTrees.pas -------------------------------------------------------------------------------- /VCLs/CometTrees.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CWBudde/AresGalaxy/b6136fd50c80f73be3115b315bb15bbbf9d1b528/VCLs/CometTrees.res -------------------------------------------------------------------------------- /VCLs/CometTreesReg.pas: -------------------------------------------------------------------------------- 1 | unit CometTreesReg; 2 | 3 | // This unit is an addendum to VirtualTrees.pas and contains code of design time editors as well as 4 | // for theirs and the tree's registration. 5 | 6 | interface 7 | 8 | {$include Compilers.inc} 9 | 10 | uses 11 | Windows, Classes, DesignIntf, DesignEditors, VCLEditors, PropertyCategories, 12 | ColnEdit, CometTrees, VCHeaderPopup; 13 | 14 | type 15 | TVirtualTreeEditor = class (TDefaultEditor) 16 | public 17 | procedure Edit; override; 18 | end; 19 | 20 | procedure Register; 21 | 22 | //---------------------------------------------------------------------------------------------------------------------- 23 | 24 | implementation 25 | 26 | uses 27 | StrEdit, Dialogs, TypInfo, SysUtils, Graphics; 28 | 29 | type 30 | // The usual trick to make a protected property accessible in the ShowCollectionEditor call below. 31 | TVirtualTreeCast = class(TBaseCometTree); 32 | TGetPropEditProc = TGetPropProc; 33 | //---------------------------------------------------------------------------------------------------------------------- 34 | 35 | procedure TVirtualTreeEditor.Edit; 36 | begin 37 | ShowCollectionEditor(Designer, Component, TVirtualTreeCast(Component).Header.Columns, 'Columns'); 38 | end; 39 | 40 | 41 | procedure DrawBoolean(Checked: Boolean; ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean); 42 | var 43 | BoxSize, 44 | EntryWidth: Integer; 45 | R: TRect; 46 | State: Cardinal; 47 | begin 48 | with ACanvas do 49 | begin 50 | FillRect(ARect); 51 | 52 | BoxSize := ARect.Bottom - ARect.Top; 53 | EntryWidth := ARect.Right - ARect.Left; 54 | 55 | R := Rect(ARect.Left + (EntryWidth - BoxSize) div 2, ARect.Top, ARect.Left + (EntryWidth + BoxSize) div 2, 56 | ARect.Bottom); 57 | InflateRect(R, -1, -1); 58 | State := DFCS_BUTTONCHECK; 59 | if Checked then 60 | State := State or DFCS_CHECKED; 61 | DrawFrameControl(Handle, R, DFC_BUTTON, State); 62 | end; 63 | end; 64 | 65 | procedure Register; 66 | 67 | begin 68 | RegisterComponents('comet', [TVirtualStringTree, TCometTree, TVTHeaderPopupMenu]); 69 | RegisterComponentEditor(TVirtualStringTree, TVirtualTreeEditor); 70 | RegisterComponentEditor(TCometTree, TVirtualTreeEditor); 71 | 72 | // Categories: 73 | RegisterPropertiesInCategory(sActionCategoryName, TBaseCometTree, 74 | ['ChangeDelay', 'EditDelay']); 75 | 76 | RegisterPropertiesInCategory(sDataCategoryName, TBaseCometTree, 77 | ['NodeDataSize', 78 | 'RootNodeCount', 79 | 'OnCompareNodes', 80 | 'OnGetNodeDataSize', 81 | 'OnInitNode', 82 | 'OnInitChildren', 83 | 'OnFreeNode', 84 | 'OnGetNodeWidth', 85 | 'OnGetPopupMenu', 86 | 'OnLoadNode', 87 | 'OnSaveNode', 88 | 'OnResetNode', 89 | 'OnNodeMov*', 90 | 'OnStructureChange', 91 | 'OnUpdating', 92 | 'OnGetText', 93 | 'OnNewText', 94 | 'OnShortenString']); 95 | 96 | RegisterPropertiesInCategory(slayoutCategoryName, TBaseCometTree, 97 | ['AnimationDuration', 98 | 'AutoExpandDelay', 99 | 'AutoScroll*', 100 | 'ButtonStyle', 101 | 'DefaultNodeHeight', 102 | '*Images*', 'OnGetImageIndex', 103 | 'Header', 104 | 'Indent', 105 | 'LineStyle', 'OnGetLineStyle', 106 | 'CheckImageKind', 107 | 'Options', 108 | 'Margin', 109 | 'NodeAlignment', 110 | 'ScrollBarOptions', 111 | 'SelectionCurveRadius', 112 | 'TextMargin']); 113 | 114 | RegisterPropertiesInCategory(sVisualCategoryName, TBaseCometTree, 115 | ['Background*', 116 | 'ButtonFillMode', 117 | 'CustomCheckimages', 118 | 'Colors', 119 | 'LineMode']); 120 | 121 | RegisterPropertiesInCategory(sHelpCategoryName, TBaseCometTree, 122 | ['Hint*', 'On*Hint*', 'On*Help*']); 123 | 124 | RegisterPropertiesInCategory(sDragNDropCategoryName, TBaseCometTree, 125 | ['ClipboardFormats', 126 | 'DefaultPasteMode', 127 | 'OnCreateDataObject', 128 | 'OnCreateDragManager', 129 | 'OnGetUserClipboardFormats', 130 | 'OnNodeCop*', 131 | 'OnDragAllowed', 132 | 'OnRenderOLEData']); 133 | 134 | RegisterPropertiesInCategory(sInputCategoryName, TBaseCometTree, 135 | ['DefaultText', 136 | 'DrawSelectionMode', 137 | 'WantTabs', 138 | 'OnChang*', 139 | 'OnCollaps*', 140 | 'OnExpand*', 141 | 'OnCheck*', 142 | 'OnEdit*', 143 | 'On*Click', 144 | 'OnFocus*', 145 | 'OnCreateEditor', 146 | 'OnScroll', 147 | 'OnHotChange']); 148 | end; 149 | 150 | //---------------------------------------------------------------------------------------------------------------------- 151 | 152 | end. 153 | -------------------------------------------------------------------------------- /VCLs/CometVerInfo.pas: -------------------------------------------------------------------------------- 1 | unit CometVerInfo; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs; 7 | 8 | type 9 | VS_FIXEDFILEINFO = record 10 | dwSignature: Integer; 11 | dwStrucVersion: Integer; 12 | dwFileVersionMS: Integer; 13 | dwFileVersionLS: Integer; 14 | dwProductVersionMS: Integer; 15 | dwProductVersionLS: Integer; 16 | dwFileFlagsMask: Integer; 17 | dwFileFlags: Integer; 18 | dwFileOS: Integer; 19 | dwFileType: Integer; 20 | dwFileSubtype: Integer; 21 | dwFileDateMS: Integer; 22 | dwFileDateLS: Integer 23 | end; 24 | 25 | TCmtVerNfo = class(TComponent) 26 | private 27 | FAutoGetInfo: Boolean; 28 | FHaveVersionInfo: Boolean; 29 | FhZero: DWORD; 30 | FVersionInfoSize: Integer; 31 | FVersionInfoBuffer: PWidechar; 32 | FFilename: WideString; 33 | FParam: Pointer; 34 | FParameterLength: UINT; 35 | FLanguage: Integer; 36 | FCharSet: Integer; 37 | FLangChar: String[8]; 38 | FLanguageStr: String[4]; 39 | FCharSetStr: String[4]; 40 | FFixedFileInfo: VS_FIXEDFILEINFO; 41 | protected 42 | function GetFileName: WideString; 43 | procedure SetFileName(Name: WideString); 44 | public 45 | constructor Create(AOwner: TComponent); override; 46 | destructor Destroy; override; 47 | published 48 | procedure GetFileInfo(FileName: WideString); 49 | procedure SetAutoGetInfo(Value: Boolean); 50 | 51 | property FileName: WideString read GetFileName write SetFileName; 52 | property AutoGetInfo: Boolean read FAutoGetInfo write SetAutoGetInfo default True; 53 | 54 | property HaveVersionInfo: Boolean read FHaveVersionInfo; 55 | property Language: Integer read FLanguage; 56 | property CharSet: Integer read FCharSet; 57 | property Signature: Integer read FFixedFileInfo.dwSignature; 58 | property StrucVersion: Integer read FFixedFileInfo.dwStrucVersion; 59 | property FileVersionMS: Integer read FFixedFileInfo.dwFileVersionMS; 60 | property FileVersionLS: Integer read FFixedFileInfo.dwFileVersionLS; 61 | property ProductVersionMS: Integer read FFixedFileInfo.dwProductVersionMS; 62 | property ProductVersionLS: Integer read FFixedFileInfo.dwProductVersionLS; 63 | property FileFlagsMask: Integer read FFixedFileInfo.dwFileFlagsMask; 64 | property FileFlags: Integer read FFixedFileInfo.dwFileFlags; 65 | property FileOS: Integer read FFixedFileInfo.dwFileOS; 66 | property FileType: Integer read FFixedFileInfo.dwFileType; 67 | property FileSubtype: Integer read FFixedFileInfo.dwFileSubtype; 68 | property FileDateMS: Integer read FFixedFileInfo.dwFileDateMS; 69 | property FileDateLS: Integer read FFixedFileInfo.dwFileDateLS; 70 | function GetValue(ValueName: String): WideString; 71 | end; 72 | 73 | procedure Register; 74 | 75 | implementation 76 | 77 | constructor TCmtVerNfo.Create(AOwner: TComponent); 78 | var 79 | Lung: Integer; 80 | buffer: array [0..MAX_PATH - 1] of WideChar; 81 | widstr: WideString; 82 | begin 83 | inherited Create(AOwner); 84 | try 85 | FFilename := ''; 86 | FAutoGetInfo := True; 87 | FLanguage := 0; 88 | FCharSet := 0; 89 | 90 | Lung := GetModuleFileNameW(0, Buffer, SizeOf(Buffer)); 91 | 92 | if Lung = 0 then 93 | exit; 94 | 95 | SetLength(widstr, Lung); 96 | move(buffer, widstr[1], Lung * 2); 97 | 98 | SetFileName(widstr); 99 | GetFileInfo(FileName); 100 | except 101 | end; 102 | end; 103 | 104 | destructor TCmtVerNfo.Destroy; 105 | begin 106 | inherited Destroy; 107 | try 108 | FFilename := ''; 109 | if FVersionInfoBuffer <> nil then 110 | FreeMem(FVersionInfoBuffer); 111 | except 112 | end; 113 | end; 114 | 115 | function TCmtVerNfo.GetFileName: WideString; 116 | begin 117 | Result := FFilename; 118 | end; 119 | 120 | procedure TCmtVerNfo.SetFileName(Name: WideString); 121 | begin 122 | FFilename := name; 123 | end; 124 | 125 | procedure TCmtVerNfo.SetAutoGetInfo(Value: Boolean); 126 | begin 127 | try 128 | if FAutoGetInfo <> Value then 129 | begin 130 | FAutoGetInfo := Value; 131 | if FAutoGetInfo then 132 | SetFileName(ParamStr(0)); 133 | GetFileInfo(FFilename); 134 | end; 135 | except 136 | end; 137 | end; 138 | 139 | procedure TCmtVerNfo.GetFileInfo(FileName: WideString); 140 | var 141 | Temp: Integer; 142 | begin 143 | try 144 | FVersionInfoSize := GetFileVersionInfoSizeW(PWidechar(FFilename), FhZero); 145 | FHaveVersionInfo := (FVersionInfoSize <> 0); 146 | 147 | FVersionInfoBuffer := AllocMem(FVersionInfoSize); 148 | FHaveVersionInfo := GetFileVersionInfoW(PWidechar(FFilename), 0, 149 | FVersionInfoSize, FVersionInfoBuffer); 150 | 151 | if FHaveVersionInfo then 152 | begin 153 | VerQueryValueW(FVersionInfoBuffer, '\', FParam, FParameterLength); 154 | CopyMemory(@FFixedFileInfo, FParam, FParameterLength); 155 | VerQueryValueW(FVersionInfoBuffer, '\VarFileInfo\Translation', FParam, 156 | FParameterLength); 157 | Temp := Integer(FParam^); 158 | FLanguage := Temp and $FFFF; 159 | FCharSet := ((Temp and $FFFF0000) shr 16) and $FFFF; 160 | FLanguageStr := IntToHex(FLanguage, 4); 161 | FCharSetStr := IntToHex(FCharSet, 4); 162 | FLangChar := FLanguageStr + FCharSetStr; 163 | end; 164 | 165 | except 166 | FVersionInfoBuffer := nil; 167 | end; 168 | end; 169 | 170 | function TCmtVerNfo.GetValue(ValueName: String): WideString; 171 | var 172 | Res: Boolean; 173 | begin 174 | try 175 | if (Win32Platform = VER_PLATFORM_WIN32_NT) then 176 | begin 177 | Res := VerQueryValueW(FVersionInfoBuffer, 178 | PWidechar(WideString('\StringFileInfo\' + FLangChar + '\' + ValueName)), 179 | FParam, FParameterLength); 180 | if Res then 181 | begin 182 | SetLength(Result,FParameterLength-1); 183 | move(FParam^, Result[1], (FParameterLength - 1) * 2); 184 | end 185 | else 186 | Result := IntToStr(GetLastError); 187 | end 188 | else 189 | begin 190 | Res := VerQueryValue(FVersionInfoBuffer, 191 | PChar(string('\StringFileInfo\' + FLangChar + '\' + ValueName)), 192 | FParam, FParameterLength); 193 | if Res then 194 | Result := 'TODO' // TODO: StrPas(FParam) 195 | else 196 | Result := IntToStr(GetLastError); 197 | end; 198 | except 199 | end; 200 | end; 201 | 202 | procedure Register; 203 | begin 204 | RegisterComponents('Comet', [TCmtVerNfo]); 205 | end; 206 | 207 | end. 208 | -------------------------------------------------------------------------------- /VCLs/README.txt: -------------------------------------------------------------------------------- 1 | 2007-03-03 AresGalaxy's VCLs 2 | 3 | Units in this archive: 4 | BGImPanel 5 | CmtHint 6 | CmtVerNfo 7 | CometBtnEdit 8 | CometPageView 9 | CometTopicPnl 10 | CometTrack 11 | CometTrees 12 | CometTreesReg 13 | FolderBrowse 14 | MPlayerPanel 15 | uTrayIcon 16 | VCHeaderPopup 17 | WinSplit 18 | XPButton 19 | XPMan (for Delphi6 and Older versions) 20 | 21 | 22 | 23 | Additional libraries (not included): 24 | Project JEDI http://www.delphi-jedi.org/ 25 | DSPack http://www.progdigy.com/modules.php?name=DSPack 26 | Tnt Delphi UNICODE Controls Project http://www.tntware.com/delphicontrols/unicode/ 27 | 28 | 29 | AresGalaxy's homepage: http://aresgalaxy.sourceforge.net -------------------------------------------------------------------------------- /VCLs/WINSPLIT.RES: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CWBudde/AresGalaxy/b6136fd50c80f73be3115b315bb15bbbf9d1b528/VCLs/WINSPLIT.RES -------------------------------------------------------------------------------- /VCLs/WinSplit.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CWBudde/AresGalaxy/b6136fd50c80f73be3115b315bb15bbbf9d1b528/VCLs/WinSplit.pas -------------------------------------------------------------------------------- /VCLs/WindowsXP.rc: -------------------------------------------------------------------------------- 1 | 1 24 "sample.manifest" -------------------------------------------------------------------------------- /VCLs/XPMan.pas: -------------------------------------------------------------------------------- 1 | {*******************************************************} 2 | { } 3 | { Borland Delphi Visual Component Library } 4 | { } 5 | { Copyright (c) 2002 Borland Software Corporation } 6 | { } 7 | {*******************************************************} 8 | 9 | unit XPMan; 10 | {$WEAKPACKAGEUNIT ON} 11 | interface 12 | 13 | uses 14 | SysUtils, Classes; 15 | 16 | type 17 | TXPManifest = class(TComponent) 18 | end; 19 | 20 | {$R WindowsXP.res} 21 | 22 | implementation 23 | 24 | end. 25 | -------------------------------------------------------------------------------- /VCLs/arescp.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CWBudde/AresGalaxy/b6136fd50c80f73be3115b315bb15bbbf9d1b528/VCLs/arescp.res -------------------------------------------------------------------------------- /VCLs/arescp_Icon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CWBudde/AresGalaxy/b6136fd50c80f73be3115b315bb15bbbf9d1b528/VCLs/arescp_Icon.ico -------------------------------------------------------------------------------- /VCLs/bmpmplayer.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CWBudde/AresGalaxy/b6136fd50c80f73be3115b315bb15bbbf9d1b528/VCLs/bmpmplayer.res -------------------------------------------------------------------------------- /VCLs/bmptrackbar.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CWBudde/AresGalaxy/b6136fd50c80f73be3115b315bb15bbbf9d1b528/VCLs/bmptrackbar.res -------------------------------------------------------------------------------- /adler32.obj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CWBudde/AresGalaxy/b6136fd50c80f73be3115b315bb15bbbf9d1b528/adler32.obj -------------------------------------------------------------------------------- /ares.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CWBudde/AresGalaxy/b6136fd50c80f73be3115b315bb15bbbf9d1b528/ares.ico -------------------------------------------------------------------------------- /ares.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CWBudde/AresGalaxy/b6136fd50c80f73be3115b315bb15bbbf9d1b528/ares.res -------------------------------------------------------------------------------- /ares_types.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CWBudde/AresGalaxy/b6136fd50c80f73be3115b315bb15bbbf9d1b528/ares_types.pas -------------------------------------------------------------------------------- /ares_types_root.pas: -------------------------------------------------------------------------------- 1 | { 2 | this file is part of Ares 3 | Aresgalaxy ( http://aresgalaxy.sourceforge.net ) 4 | 5 | This program is free software; you can redistribute it and/or 6 | modify it under the terms of the GNU General Public License 7 | as published by the Free Software Foundation; either 8 | version 2 of the License, or (at your option) any later version. 9 | 10 | This program is distributed in the hope that it will be useful, 11 | but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | GNU General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program; if not, write to the Free Software 17 | Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 18 | } 19 | 20 | { 21 | Description: 22 | application structures are listed here 23 | } 24 | 25 | unit ares_types_root; 26 | 27 | interface 28 | 29 | uses 30 | Windows; 31 | 32 | type 33 | TNetStreamType=( 34 | nsTRoot, 35 | nsTMovies, 36 | nsTTv, 37 | nsTUnknown 38 | ); 39 | 40 | PRecordNetStreamChannel=^RecordNetStreamChannel; 41 | RecordNetStreamChannel=record 42 | language: string; 43 | streamUrl: WideString; 44 | streamPlaypath: WideString; 45 | webCapt: WideString; 46 | webUrl: string; 47 | capt: WideString; 48 | end; 49 | 50 | TDataNodeType = ( 51 | dnt_Null, 52 | dnt_download, 53 | dnt_PartialUpload, 54 | dnt_PartialDownload, 55 | dnt_downloadSource, 56 | dnt_upload, 57 | dnt_bittorrentMain, 58 | dnt_bittorrentSource 59 | ); 60 | 61 | PRecord_data_node=^Record_data_node; 62 | Record_data_node=record 63 | m_type: TDataNodeType; 64 | data: Pointer; 65 | end; 66 | 67 | TArguments = array of string; 68 | 69 | PRecord_httpheader_item=^Record_httpheader_item; 70 | Record_httpheader_item=record 71 | key: string; 72 | value: string; 73 | end; 74 | 75 | // string structure for library categs 76 | precord_string = ^record_string; 77 | record_string = record 78 | str: string; 79 | counter: Integer; 80 | crc: Word; 81 | len: Byte; 82 | end; 83 | 84 | HINTERNET = pointer; 85 | 86 | //thread client, structure for HASH source/resume search 87 | precord_download_hash=^record_download_hash; 88 | record_download_hash = record 89 | hash: string; 90 | crchash: Word; 91 | handle_download: Cardinal; 92 | end; 93 | 94 | //thread_client avoid some dead loop while adding/removing hosts in discovery 95 | precord_nodo_provato=^record_nodo_provato; 96 | record_nodo_provato=record 97 | host: string; 98 | when: Cardinal; 99 | isBad: Boolean; 100 | end; 101 | 102 | TSocks_type = ( 103 | SoctNone, 104 | SoctSock4, 105 | SoctSock5 106 | ); 107 | 108 | // string parse helper structure 109 | precord_title_album_artist=^record_title_album_artist; 110 | record_title_album_artist=record 111 | artist, 112 | album, 113 | title: WideString; 114 | end; 115 | 116 | implementation 117 | 118 | end. 119 | 120 | -------------------------------------------------------------------------------- /blcksock.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CWBudde/AresGalaxy/b6136fd50c80f73be3115b315bb15bbbf9d1b528/blcksock.pas -------------------------------------------------------------------------------- /class_cmdlist.pas: -------------------------------------------------------------------------------- 1 | { 2 | this file is part of Ares 3 | Aresgalaxy ( http://aresgalaxy.sourceforge.net ) 4 | 5 | This program is free software; you can redistribute it and/or 6 | modify it under the terms of the GNU General Public License 7 | as published by the Free Software Foundation; either 8 | version 2 of the License, or (at your option) any later version. 9 | 10 | This program is distributed in the hope that it will be useful, 11 | but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | GNU General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program; if not, write to the Free Software 17 | Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 18 | 19 | ######### NOTICE: this comes from the SlavaNap source code. ########### 20 | 21 | Copyright 2001,2002 by SlavaNap development team 22 | Released under GNU General Public License 23 | 24 | Latest version is available at 25 | http://www.slavanap.org 26 | 27 | ********************************************************** 28 | 29 | Unit: class_cmdlist 30 | 31 | TNapCmd and TNapCmdList declarations 32 | 33 | *********************************************************} 34 | 35 | unit class_cmdlist; 36 | 37 | interface 38 | 39 | uses 40 | Windows, Classes2, SysUtils; 41 | 42 | type 43 | TNapCmd = record 44 | id : Integer; 45 | cmd : String; 46 | end; 47 | PNapCmd = ^TNapCmd; 48 | TNapCmdList = class(TMyList) 49 | function Add(Value: TNapCmd): Integer; 50 | procedure Insert(Index: Integer; Value: TNapCmd); 51 | procedure Clear; override; 52 | procedure Delete(Index: Integer); 53 | function AddCmd(id: Integer; cmd: string): Integer; 54 | function Cmd(index: Integer): TNapCmd; 55 | function Id(index: Integer): Integer; 56 | function Str(index: Integer): String; 57 | function FindByCmd(cmd: String; ignore_case: Boolean): Integer; 58 | function FindById(id: Integer): Integer; 59 | function FindItem(id: Integer; cmd: String): Integer; 60 | constructor Create; 61 | destructor Destroy; override; 62 | function GetLength: Integer; 63 | end; 64 | 65 | function CreateCmdList: TNapCmdList; 66 | 67 | implementation 68 | 69 | 70 | 71 | function CreateCmdList: TNapCmdList; 72 | begin 73 | Result := TNapCmdList.Create; 74 | end; 75 | 76 | function CreateItem: PNapCmd; 77 | var 78 | data: PNapCmd; 79 | begin 80 | data := AllocMem(sizeof(TNapCmd)); 81 | Pointer(data^.cmd) := nil; 82 | Result := data; 83 | end; 84 | 85 | procedure FreeItem(item: PNapCmd); 86 | begin 87 | if Pointer(item^.cmd)<>nil then SetLength(item^.cmd,0); 88 | Finalize(item^); 89 | FreeMem(item,sizeof(TNapCmd)); 90 | end; 91 | 92 | procedure DeleteItem(item: PNapCmd); 93 | begin 94 | if Pointer(item^.cmd)<>nil then SetLength(item^.cmd,0); 95 | FreeItem(item); 96 | end; 97 | 98 | {* * * * * TNapCmdList * * * * *} 99 | 100 | function TNapCmdList.Add(Value: TNapCmd): Integer; 101 | var 102 | data:PNapCmd; 103 | begin 104 | data := CreateItem; 105 | with data^ do 106 | begin 107 | cmd := Value.cmd; 108 | id := Value.id; 109 | end; 110 | Result := inherited Add(data); 111 | end; 112 | 113 | procedure TNapCmdList.Insert(Index: Integer; Value: TNapCmd); 114 | var 115 | data:PNapCmd; 116 | begin 117 | data := CreateItem; 118 | with data^ do 119 | begin 120 | cmd := Value.cmd; 121 | id := Value.id; 122 | end; 123 | inherited Insert(Index,data); 124 | end; 125 | 126 | procedure TNapCmdList.Clear; 127 | begin 128 | while count>0 do 129 | Delete(count-1); 130 | inherited Clear; 131 | end; 132 | 133 | procedure TNapCmdList.Delete(Index: Integer); 134 | begin 135 | if (Index<0) or (Index>=Count) then exit; 136 | if Items[Index]<>nil then 137 | DeleteItem(Items[Index]); 138 | Inherited Delete(index); 139 | end; 140 | 141 | function TNapCmdList.AddCmd(id: Integer; cmd: string): Integer; 142 | var 143 | data: TNapCmd; 144 | begin 145 | data.id := id; 146 | data.cmd := cmd; 147 | Result := Add(data); 148 | end; 149 | 150 | function TNapCmdList.Cmd(index :Integer): TNapCmd; 151 | var 152 | data: TNapCmd; 153 | begin 154 | if (index>=0) and (index=0) and (index=0) and (indexlocalclient (data from remote user) 65 | CMD_RELAYING_SOCKET_OUTBUFSIZE = 4; //server->localclient (slow down) 66 | MSG_CLIENT_RELAYDIRECTCHATPACKET = 14; //localclient->server->remote requesting user 67 | CMD_RELAYING_SOCKET_REQUEST = 5; // someone wants us to relay to our local user 68 | CMD_RELAYING_SOCKET_OFFLINE = 6; //let remote user know user isn't here anymore 69 | CMD_RELAYING_SOCKET_START = 7; //let remote user know we're ready 70 | CMD_SERVER_RELAYINGSOCKETREQUEST = 8; // someone wants us to relay to our local user, let client know this 71 | CMD_CLIENT_RELAYDIRECTCHATDROP = 2; // localclient closes window 72 | 73 | implementation 74 | 75 | end. 76 | -------------------------------------------------------------------------------- /const_commands_pfs.pas: -------------------------------------------------------------------------------- 1 | { 2 | this file is part of Ares 3 | Aresgalaxy ( http://aresgalaxy.sourceforge.net ) 4 | 5 | This program is free software; you can redistribute it and/or 6 | modify it under the terms of the GNU General Public License 7 | as published by the Free Software Foundation; either 8 | version 2 of the License, or (at your option) any later version. 9 | 10 | This program is distributed in the hope that it will be useful, 11 | but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | GNU General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program; if not, write to the Free Software 17 | Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 18 | } 19 | 20 | 21 | { 22 | Description: 23 | partial file sharing commands 24 | } 25 | 26 | 27 | unit const_commands_pfs; 28 | 29 | interface 30 | 31 | const 32 | 33 | CMD_PARTIAL_SENDME_HASH = 1; 34 | CMD_PARTIAL_IGOT_HASH = 2; 35 | CMD_PARTIAL_SENDME_CHUNK_8B = 13; //ex 3 36 | CMD_PARTIAL_BUSY = 14; 37 | CMD_PARTIAL_GOTO_CHILD = 4; //deprecated 38 | CMD_PARTIAL_MISSING_CHUNK = 5; 39 | CMD_PARTIAL_HERE_DATA = 6; 40 | CMD_PARTIAL_ALLOCATE_THIS_8B = 17; //ex 7 41 | CMD_PARTIAL_HERE_MY_XIP = 8; 42 | CMD_PARTIAL_IMNOW_REGULARSOURCE = 10; 43 | CMD_PARTIAL_HERE_DATA_8B = 12; 44 | CMD_PARTIAL_IMSLOW = 18; 45 | CMD_PARTIAL_BITFIELD = 20; 46 | 47 | implementation 48 | 49 | end. 50 | -------------------------------------------------------------------------------- /const_supernode_commands.pas: -------------------------------------------------------------------------------- 1 | { 2 | this file is part of Ares 3 | Aresgalaxy ( http://aresgalaxy.sourceforge.net ) 4 | 5 | This program is free software; you can redistribute it and/or 6 | modify it under the terms of the GNU General Public License 7 | as published by the Free Software Foundation; either 8 | version 2 of the License, or (at your option) any later version. 9 | 10 | This program is distributed in the hope that it will be useful, 11 | but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | GNU General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program; if not, write to the Free Software 17 | Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 18 | } 19 | 20 | 21 | { 22 | Description: 23 | supernode server communication 24 | } 25 | 26 | unit const_supernode_commands; 27 | 28 | interface 29 | 30 | const 31 | //bye packet codes 32 | ERROR_PAYLOADBIG = 1; 33 | ERROR_FLOWTIMEOUT = 2; 34 | ERROR_NETWORKISSUE = 3; 35 | ERROR_FLUSHQUEUE_OVERFLOW = 4; 36 | ERROR_DECOMPRESSION_ERROR = 5; 37 | ERROR_DECOMPRESSED_PACKETBIG = 6; 38 | ERROR_SYNCTIMEOUT = 7; 39 | ERROR_SYNC_OLDBUILDERROR = 8; 40 | ERROR_SYNC_NOBUILDERROR = 9; 41 | ERROR_FLUSH_OVERFLOW = 10; 42 | 43 | // end of search descriptions 44 | RSN_ENDOFSEARCH_ASREQUESTED = 1; 45 | RSN_ENDOFSEARCH_TOMANYSEARCHES= 2; 46 | RSN_ENDOFSEARCH_MISSINGFIELDS = 3; 47 | RSN_ENDOFSEARCH_ENOUGHRESULTS = 4; 48 | 49 | // handle not encrypted packets 50 | CHAR_MARKER_NOCRYPT = 6; 51 | CHAR_MARKER_NEWSTACK =5; 52 | 53 | 54 | MSG_SERVER_LOGIN_OK = 1; 55 | MSG_SERVER_YOUR_NICK = 5; 56 | MSG_SERVER_PUSH_REQ = 8; 57 | MSG_SERVER_SEARCH_RESULT = 18; 58 | MSG_SERVER_SEARCH_ENDOF = 19; 59 | MSG_SERVER_STATS = 30; 60 | MSG_LINKED_ENDOFSYNCH = 45; 61 | MSG_LINKED_ENDOFSYNCH_100 = 145; 62 | MSG_SERVER_YOUR_IP = 37; 63 | MSG_SERVER_HERE_KSERVS = 38; 64 | MSG_SERVER_PRELOGIN_OK = 51; 65 | MSG_SERVER_PRELOGIN_OK_NEWNET_LATEST = 52; 66 | MSG_SERVER_HERE_CACHEPATCH = 53; 67 | MSG_SERVER_HERE_CACHEPATCH2 = 54; 68 | MSG_SERVER_HERE_CACHEPATCH3 = 55; //2952 69 | MSG_SERVER_PRELGNOK = 56; //2958+ 17-2-2005 70 | MSG_SERVER_PRELGNOKNOCRYPT = 60; 71 | MSG_SERVER_HERE_CHATCACHEPATCH = 57; //2960+ 72 | MSG_SERVER_PRELOGFAILLOGSECURTYIP = 58; 73 | MSG_SERVER_PRELOGFAILLOGBUSY = 59; 74 | MSG_SERVER_LINK_FULL = 94; 75 | MSG_SERVER_PUSH_CHATREQ_NEW = 97; 76 | MSG_SERVER_COMPRESSED = 101; 77 | MSG_LINKED_PING = 3; 78 | MSG_LINKED_PING_100 = 103; 79 | MSG_LINKED_QUERY = 19; 80 | MSG_LINKED_QUERY_100 = 119; 81 | MSG_LINKED_QUERY_HIT = 11; 82 | MSG_LINKED_QUERY_HIT_100 = 111; 83 | MSG_LINKED_BYE_PACKET = 36; 84 | MSG_LINKED_BYE_PACKET_100 = 136; 85 | MSG_LINKED_QUERYHASH = 70; 86 | MSG_LINKED_QUERYHASH_100 = 170; 87 | MSG_LINKED_QUERYHASH_HIT = 75; 88 | MSG_LINKED_QUERYHASH_HIT_100 = 175; 89 | 90 | 91 | 92 | // udp protocol 93 | MSG_SERV_UDP_PRELOGIN_REQ = 31; 94 | MSG_SERV_UDP_HERE_MYKEY = 32; 95 | MSG_SERV_UDP_LOGINREQ = 33; 96 | MSG_SERV_UDP_LOGIN_OK = 34; 97 | MSG_SERV_UDP_QUERY = 26; 98 | MSG_SERV_UDP_QUERY_HIT = 27; 99 | MSG_SERV_UDP_QUERY_ACK = 28; 100 | MSG_SERV_UDP_PING = 30; 101 | MSG_SERV_UDP_PONG = 37; 102 | MSG_SERV_UDP_QUERYHASH = 35; 103 | MSG_CLNT_UDP_PUSH = 45; 104 | MSG_SRV_UDP_PUSH_ACK = 46; 105 | MSG_SRV_UDP_PUSH_FAIL = 47; 106 | MSG_CLNT_UDP_CHATPUSH = 41; 107 | MSG_SRV_UDP_CHATPUSH_ACK = 42; 108 | MSG_SRV_UDP_CHATPUSH_FAIL = 43; 109 | 110 | 111 | 112 | // deprecated stuff 113 | //MSG_LINKED_USERLOGIN = 33; //2964 114 | //MSG_LINKED_USERsSYNC = 34; //2964 115 | //MSG_LINKED_DUMMY = 35; //per bug cryptazione su supernodo in parse receive 3) then begin 94 | words := (ord(strin[i]) and ($FF shr index)); 95 | index := (index + 5) mod 8; 96 | words := words shl index; 97 | if (i < length(strin)) then words := words or (ord(strin[i + 1]) shr (8 - index)); 98 | 99 | inc(i); 100 | end else begin 101 | words := (ord(strin[i]) shr (8 - (index + 5))) and $1F; 102 | index := (index + 5) mod 8; 103 | if (index = 0) then inc(i); 104 | end; 105 | 106 | 107 | Result := result+base32Chars[words+1]; 108 | 109 | end; 110 | end; 111 | 112 | function EncodeBase64(const Value: string): string; 113 | const 114 | TableBase64 = 115 | 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/='; 116 | begin 117 | Result := Encode3to4(Value, TableBase64); 118 | end; 119 | 120 | function DecodeBase64(const Value: string): string; 121 | const 122 | ReTablebase64 = 123 | #$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$3E +#$40 124 | +#$40 +#$40 +#$3F +#$34 +#$35 +#$36 +#$37 +#$38 +#$39 +#$3A +#$3B +#$3C 125 | +#$3D +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$00 +#$01 +#$02 +#$03 126 | +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A +#$0B +#$0C +#$0D +#$0E +#$0F 127 | +#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18 +#$19 +#$40 +#$40 128 | +#$40 +#$40 +#$40 +#$40 +#$1A +#$1B +#$1C +#$1D +#$1E +#$1F +#$20 +#$21 129 | +#$22 +#$23 +#$24 +#$25 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D 130 | +#$2E +#$2F +#$30 +#$31 +#$32 +#$33 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40; 131 | begin 132 | Result := Decode4to3Ex(Value, ReTableBase64); 133 | end; 134 | 135 | function Decode4to3Ex(const Value, Table: string): string; 136 | type 137 | TDconvert = record 138 | case byte of 139 | 0: (a0, a1, a2, a3: char); 140 | 1: (i: integer); 141 | end; 142 | var 143 | x, y, l, lv: Integer; 144 | d: TDconvert; 145 | dl: integer; 146 | c: byte; 147 | p: ^char; 148 | begin 149 | lv := Length(Value); 150 | SetLength(Result, lv); 151 | x := 1; 152 | dl := 4; 153 | d.i := 0; 154 | p := pointer(result); 155 | while x <= lv do 156 | begin 157 | y := Ord(Value[x]); 158 | if y in [33..127] then 159 | c := Ord(Table[y - 32]) 160 | else 161 | c := 64; 162 | Inc(x); 163 | if c > 63 then 164 | continue; 165 | d.i := (d.i shl 6) or c; 166 | dec(dl); 167 | if dl <> 0 then 168 | continue; 169 | p^ := d.a2; 170 | inc(p); 171 | p^ := d.a1; 172 | inc(p); 173 | p^ := d.a0; 174 | inc(p); 175 | d.i := 0; 176 | dl := 4; 177 | end; 178 | case dl of 179 | 1: 180 | begin 181 | d.i := d.i shr 2; 182 | p^ := d.a1; 183 | inc(p); 184 | p^ := d.a0; 185 | inc(p); 186 | end; 187 | 2: 188 | begin 189 | d.i := d.i shr 4; 190 | p^ := d.a0; 191 | inc(p); 192 | end; 193 | end; 194 | l := integer(p) - integer(pointer(result)); 195 | SetLength(Result, l); 196 | end; 197 | 198 | function Encode3to4(const Value, Table: string): string; 199 | var 200 | c: Byte; 201 | n, l: Integer; 202 | Count: Integer; 203 | DOut: array [0..3] of Byte; 204 | begin 205 | SetLength(Result, ((Length(Value) + 2) div 3) * 4); 206 | l := 1; 207 | Count := 1; 208 | while Count <= Length(Value) do 209 | begin 210 | c := Ord(Value[Count]); 211 | Inc(Count); 212 | DOut[0] := (c and $FC) shr 2; 213 | DOut[1] := (c and $03) shl 4; 214 | if Count <= Length(Value) then 215 | begin 216 | c := Ord(Value[Count]); 217 | Inc(Count); 218 | DOut[1] := DOut[1] + (c and $F0) shr 4; 219 | DOut[2] := (c and $0F) shl 2; 220 | if Count <= Length(Value) then 221 | begin 222 | c := Ord(Value[Count]); 223 | Inc(Count); 224 | DOut[2] := DOut[2] + (c and $C0) shr 6; 225 | DOut[3] := (c and $3F); 226 | end 227 | else 228 | begin 229 | DOut[3] := $40; 230 | end; 231 | end 232 | else 233 | begin 234 | DOut[2] := $40; 235 | DOut[3] := $40; 236 | end; 237 | for n := 0 to 3 do 238 | begin 239 | Result[l] := Table[DOut[n] + 1]; 240 | Inc(l); 241 | end; 242 | end; 243 | end; 244 | 245 | 246 | end. 247 | -------------------------------------------------------------------------------- /helper_bighints.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CWBudde/AresGalaxy/b6136fd50c80f73be3115b315bb15bbbf9d1b528/helper_bighints.pas -------------------------------------------------------------------------------- /helper_channellist.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CWBudde/AresGalaxy/b6136fd50c80f73be3115b315bb15bbbf9d1b528/helper_channellist.pas -------------------------------------------------------------------------------- /helper_check_proxy.pas: -------------------------------------------------------------------------------- 1 | { 2 | this file is part of Ares 3 | Aresgalaxy ( http://aresgalaxy.sourceforge.net ) 4 | 5 | This program is free software; you can redistribute it and/or 6 | modify it under the terms of the GNU General Public License 7 | as published by the Free Software Foundation; either 8 | version 2 of the License, or (at your option) any later version. 9 | 10 | This program is distributed in the hope that it will be useful, 11 | but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | GNU General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program; if not, write to the Free Software 17 | Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 18 | } 19 | 20 | { 21 | Description: 22 | used by control panel->proxy->check connection event...should help user with proxy configuration 23 | } 24 | 25 | unit helper_check_proxy; 26 | 27 | interface 28 | 29 | uses 30 | classes,classes2,blcksock,helper_sockets,windows,winsock,helper_unicode,vars_localiz; 31 | 32 | type 33 | tthread_checkproxy = class(tthread) 34 | protected 35 | procedure execute; override; 36 | procedure connection_failed; //synch 37 | procedure connection_succeded; //synch 38 | end; 39 | 40 | implementation 41 | 42 | uses 43 | ufrmmain,ufrm_settings; 44 | 45 | procedure tthread_checkproxy.execute; 46 | var 47 | socket: Ttcpblocksocket; 48 | tempo: Cardinal; 49 | er: Integer; 50 | lista: TMyStringList; 51 | ips: string; 52 | begin 53 | freeonterminate := True; 54 | priority := tplower; 55 | 56 | socket := ttcpblocksocket.create(true); 57 | assign_proxy_settings(socket); 58 | 59 | if socket.FSockSType=ST_Socks4 then begin //resolve hostnames for sock4 proxies 60 | lista := tmyStringList.create; 61 | ResolveNameToIP('www.networksolutions.com',lista); 62 | if lista.count<1 then begin 63 | lista.Free; 64 | socket.Free; 65 | exit; 66 | end; 67 | ips := lista.strings[0]; 68 | lista.Free; 69 | end else ips := 'www.networksolutions.com'; 70 | 71 | 72 | socket.ip := ips; 73 | socket.port := 80; 74 | socket.Connect(ips,'80'); 75 | 76 | sleep(100); 77 | tempo := gettickcount; 78 | while (gettickcount-tempo<15000) do begin 79 | 80 | er := TCPSocket_ISConnected(socket); 81 | if er=WSAEWOULDBLOCK then begin 82 | sleep(100); 83 | continue; 84 | end; 85 | if er<>0 then begin 86 | synchronize(connection_failed); 87 | socket.Free; 88 | exit; 89 | end; 90 | synchronize(connection_succeded); 91 | socket.Free; 92 | exit; 93 | end; 94 | 95 | synchronize(connection_failed); //timeout 96 | socket.Free; 97 | 98 | end; 99 | 100 | procedure tthread_checkproxy.connection_failed; //synch 101 | begin 102 | if frm_settings=nil then exit; 103 | 104 | with frm_settings do begin 105 | lbl_opt_proxy_check.caption := GetLangStringW(STR_CHECKPROXY_FAILED); 106 | btn_opt_proxy_check.enabled := True; 107 | radiobtn_noproxy.enabled := True; 108 | radiobtn_proxy4.enabled := True; 109 | radiobtn_proxy5.enabled := True; 110 | Edit_opt_proxy_addr.Enabled := True; 111 | edit_opt_proxy_login.Enabled := True; 112 | edit_opt_proxy_pass.Enabled := True; 113 | end; 114 | end; 115 | 116 | procedure tthread_checkproxy.connection_succeded; //synch 117 | begin 118 | if frm_settings=nil then exit; 119 | 120 | with frm_settings do begin 121 | lbl_opt_proxy_check.caption := GetLangStringW(STR_CHECKPROXY_SUCCEDED); 122 | btn_opt_proxy_check.enabled := True; 123 | radiobtn_noproxy.enabled := True; 124 | radiobtn_proxy4.enabled := True; 125 | radiobtn_proxy5.enabled := True; 126 | Edit_opt_proxy_addr.Enabled := True; 127 | edit_opt_proxy_login.Enabled := True; 128 | edit_opt_proxy_pass.Enabled := True; 129 | end; 130 | end; 131 | 132 | end. 133 | -------------------------------------------------------------------------------- /helper_datetime.pas: -------------------------------------------------------------------------------- 1 | { 2 | this file is part of Ares 3 | Aresgalaxy ( http://aresgalaxy.sourceforge.net ) 4 | 5 | This program is free software; you can redistribute it and/or 6 | modify it under the terms of the GNU General Public License 7 | as published by the Free Software Foundation; either 8 | version 2 of the License, or (at your option) any later version. 9 | 10 | This program is distributed in the hope that it will be useful, 11 | but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | GNU General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program; if not, write to the Free Software 17 | Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 18 | } 19 | 20 | { 21 | Description: 22 | related to datetime, used by many units to visually display formatted time eg: 00:00:00 23 | } 24 | 25 | unit helper_datetime; 26 | 27 | interface 28 | 29 | uses 30 | Sysutils, Windows; 31 | 32 | const 33 | UnixStartDate : TDateTime = 25569.0; 34 | 35 | TENTHOFSEC = 100; 36 | SECOND = 1000; 37 | MINUTE = 60000; 38 | HOUR = 3600000; 39 | DAY = 86400000; 40 | SECONDSPERDAY = 86400; 41 | 42 | function UnixToDelphiDateTime(USec: LongInt): TDateTime; 43 | function DelphiDateTimeToUnix(ConvDate: TDateTime):longint; 44 | function Format_Time(secs: Integer): string; 45 | function DelphiDateTimeSince1900(ConvDate: TDateTime):longint; 46 | function time_now: Cardinal; 47 | function HR2S(Hours: Single): Cardinal; 48 | function SEC(Seconds:Integer): Cardinal; 49 | function MIN2S(Minutes: Single): Cardinal; 50 | 51 | function DateTimeToUnixTime(const DateTime: TDateTime): Cardinal; 52 | function UnixTimeToDateTime(const UnixTime: Cardinal): TDateTime; 53 | 54 | implementation 55 | 56 | function DateTimeToUnixTime(const DateTime: TDateTime): Cardinal; 57 | var 58 | FileTime: TFileTime; 59 | SystemTime: TSystemTime; 60 | I: Int64; 61 | begin 62 | // first convert datetime to Win32 file time 63 | DateTimeToSystemTime(DateTime, SystemTime); 64 | SystemTimeToFileTime(SystemTime, FileTime); 65 | 66 | // simple maths to go from Win32 time to Unix time 67 | I := Int64(FileTime.dwHighDateTime) shl 32 + FileTime.dwLowDateTime; 68 | Result := (I - 116444736000000000) div Int64(10000000); 69 | end; 70 | 71 | function UnixTimeToDateTime(const UnixTime: Cardinal): TDateTime; 72 | var 73 | FileTime: TFileTime; 74 | SystemTime: TSystemTime; 75 | I: Int64; 76 | begin 77 | // first convert unix time to a Win32 file time 78 | I := Int64(UnixTime) * Int64(10000000) + 116444736000000000; 79 | FileTime.dwLowDateTime := DWORD(I); 80 | FileTime.dwHighDateTime := I shr 32; 81 | 82 | // Now convert to system time 83 | FileTimeToSystemTime(FileTime,SystemTime); 84 | 85 | // and finally convert the system time to TDateTime 86 | Result := SystemTimeToDateTime(SystemTime); 87 | end; 88 | 89 | function Format_Time(secs: Integer): string; 90 | var 91 | ore, Minuti, Secondi, Variabile: Integer; 92 | begin 93 | if secs>0 then 94 | begin 95 | if secs<60 then 96 | begin 97 | ore := 0; 98 | Minuti := 0; 99 | Secondi := secs; 100 | end 101 | else 102 | if secs < 3600 then 103 | begin 104 | ore := 0; 105 | Minuti := (secs div 60); 106 | Secondi := (secs-((secs div 60)*60)); 107 | end 108 | else 109 | begin 110 | ore := (secs div 3600); 111 | Variabile := (secs-((secs div 3600)*3600)); //Minuti avanzati 112 | Minuti := Variabile div 60; 113 | Secondi := Variabile-((Minuti )* 60); 114 | end; 115 | 116 | if ore=0 then 117 | Result := '' 118 | else 119 | Result := IntToStr(ore)+':'; 120 | 121 | if ((Minuti=0) and (ore=0)) then 122 | Result := '0:' 123 | else 124 | begin 125 | if Minuti<10 then 126 | begin 127 | if ore=0 then 128 | Result := IntToStr(Minuti)+':' 129 | else 130 | Result := Result+'0'+IntToStr(Minuti)+':'; 131 | end 132 | else 133 | Result := Result+IntToStr(Minuti)+':'; 134 | end; 135 | 136 | if Secondi<10 then 137 | Result := Result + '0' + IntToStr(Secondi) 138 | else 139 | Result := Result + IntToStr(Secondi); 140 | end 141 | else 142 | Result := '0:00'; // fake tempo se non ho niente nella var 143 | end; 144 | 145 | function DelphiDateTimeToUnix(ConvDate: TDateTime): LongInt; 146 | // Converts Delphi TDateTime to Unix Seconds, 147 | // ConvDate = the Date and Time that you want to convert 148 | // example: UnixSeconds := DelphiDateTimeToUnix(Now); 149 | begin 150 | Result := Round((ConvDate-UnixStartDate) * SECONDSPERDAY); 151 | end; 152 | 153 | function UnixToDelphiDateTime(USec: LongInt): TDateTime; 154 | {Converts Unix Seconds to Delphi TDateTime, 155 | USec = the Unix Date Time that you want to convert 156 | example: DelphiTimeDate := UnixToDelphiTimeDate(693596);} 157 | begin 158 | Result := (Usec / SECONDSPERDAY) + UnixStartDate; 159 | end; 160 | 161 | function time_now: Cardinal; 162 | begin 163 | Result := DelphiDateTimeSince1900(Now); 164 | end; 165 | 166 | function HR2S(Hours: Single): Cardinal; 167 | begin 168 | Result := MIN2S(Hours*60); 169 | end; 170 | 171 | function SEC(Seconds:Integer): Cardinal; 172 | begin 173 | Result := Seconds; 174 | end; 175 | 176 | function MIN2S(Minutes: Single): Cardinal; 177 | begin 178 | Result := Round(Minutes * 60); 179 | end; 180 | 181 | function DelphiDateTimeSince1900(ConvDate: TDateTime):longint; 182 | // Converts Delphi TDateTime to Unix Seconds, 183 | // ConvDate = the Date and Time that you want to convert 184 | // example: UnixSeconds := DelphiDateTimeToUnix(Now); 185 | begin 186 | Result := Round((ConvDate - 1.5) * 86400); 187 | end; 188 | 189 | end. 190 | -------------------------------------------------------------------------------- /helper_download_disk.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CWBudde/AresGalaxy/b6136fd50c80f73be3115b315bb15bbbf9d1b528/helper_download_disk.pas -------------------------------------------------------------------------------- /helper_download_misc.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CWBudde/AresGalaxy/b6136fd50c80f73be3115b315bb15bbbf9d1b528/helper_download_misc.pas -------------------------------------------------------------------------------- /helper_fakes.pas: -------------------------------------------------------------------------------- 1 | unit helper_fakes; 2 | 3 | interface 4 | 5 | uses 6 | ares_types,helper_diskio,classes,sysutils,umediar,secureHash,helper_strings,const_ares; 7 | 8 | function isFakeFile(const filename: WideString): Boolean; 9 | function GetTagSize(const Tag: ID3v2TagInfo): Integer; 10 | function Swap32(const Figure: Integer): Integer; 11 | function checkFakeByComment(const comment: string): Boolean; 12 | 13 | implementation 14 | 15 | function checkFakeByComment(const comment: string): Boolean; 16 | var 17 | i: Integer; 18 | temp,locomment: string; 19 | numbers:set of '0'..'9'; 20 | begin 21 | result := False; 22 | 23 | 24 | if length(comment)<1 then exit; 25 | locomment := lowercase(comment); 26 | if pos('aresads',locomment)<>0 then begin 27 | Result := True; 28 | exit; 29 | end; 30 | 31 | //if pos(' ',comment)=0 then exit; 32 | 33 | numbers := ['0'..'9']; 34 | 35 | temp := trim(helper_strings.strip_char(comment,' ')); 36 | if length(temp)<1 then exit; 37 | 38 | for i := 1 to length(temp) do 39 | if not (temp[i] in numbers) then begin 40 | Result := False; 41 | exit; 42 | end; 43 | 44 | Result := True; 45 | end; 46 | 47 | function isFakeFile(const filename: WideString): Boolean; 48 | var 49 | ext: string; 50 | stream: Thandlestream; 51 | count: Integer; 52 | buffer: array [0..149] of Byte; 53 | Data: array [1..100000] of Char; 54 | iwidth,iheight: Integer; 55 | wres,hres: Integer; 56 | Tag: ID3v2TagInfo; 57 | FVersionID: Byte; 58 | FSize: Integer; 59 | hashex: string; 60 | Frame: FrameHeaderNew; 61 | DataPosition, DataSize: Integer; 62 | sha1: Tsha1; 63 | //tof: Textfile; 64 | ssize: Int64; 65 | begin 66 | result := False; 67 | 68 | stream := myfileopen(filename,ARES_READONLY_ACCESS); 69 | if stream=nil then exit; 70 | ssize := stream.size; 71 | ext := lowercase(extractfileext(FileName)); 72 | 73 | if ext='.mp3' then begin 74 | count := stream.read(tag,10); 75 | Tag.FileSize := stream.size;; 76 | if count < 10 then begin 77 | FreeHandleStream(stream); 78 | exit; 79 | end; 80 | if Tag.ID=ID3V2_ID then begin 81 | FVersionID := Tag.Version; 82 | FSize := GetTagSize(Tag); 83 | 84 | { Get information from frames if version supported } 85 | if (FVersionID in [TAG_VERSION_2_2..TAG_VERSION_2_4]) and (FSize>0) then begin 86 | if FVersionID>TAG_VERSION_2_2 then begin 87 | try 88 | while (stream.PositionSizeOf(Data) then DataSize := SizeOf(Data) 94 | else DataSize := Swap32(Frame.Size); 95 | 96 | { Read frame data and set tag item if frame supported } 97 | stream.read(data, DataSize); 98 | 99 | if (Frame.Flags and $8000<>$8000) and (frame.id='APIC') then begin 100 | sha1 := tsha1.create; 101 | sha1.Transform(data[15], DataSize-14); 102 | sha1.Complete; 103 | hashex := bytestr_to_hexstr(sha1.HashValue); 104 | sha1.Free; 105 | if (hashex='4A2141B7F7E2A6098AADDDCCD722C4541A1156BA') or 106 | (hashex='0C587E43D8753ED58297792AA6041F5C1A2CA092') or 107 | (hashex='C5BE00C9BE8E1A374E3FF2F14B76B126E0059A1A') or 108 | (hashex='DD15EC62688247B4F819E96C19C1D96CC4BD6081') then begin 109 | Result := True; 110 | FreeHandleStream(stream); 111 | exit; 112 | end else begin 113 | // assignfile(tof,'c:\users\alonzo\desktop\maybefake_'+extractfilename(filename)+'.log'); 114 | // rewrite(tof); 115 | // writeln(tof,hashex); 116 | // closefile(tof); 117 | end; 118 | end; 119 | 120 | stream.seek( DataPosition + Swap32(Frame.Size),sofrombeginning); 121 | end; 122 | except 123 | end; 124 | end; 125 | end; 126 | end; 127 | 128 | FreeHandleStream(stream); 129 | end else 130 | 131 | if ext='.avi' then begin 132 | count := stream.Read(buffer,sizeof(buffer)); 133 | FreeHandleStream(Stream); 134 | if count<>sizeof(buffer) then exit; 135 | wres := buffer[67]; 136 | wres := wres shl 8; 137 | wres := wres + buffer[66]; 138 | wres := wres shl 8; 139 | wres := wres + buffer[65]; 140 | wres := wres shl 8; 141 | iwidth := wres + buffer[64]; 142 | 143 | hres := buffer[71]; 144 | hres := hres shl 8; 145 | hres := hres + buffer[70]; 146 | hres := hres shl 8; 147 | hres := hres + buffer[69]; 148 | hres := hres shl 8; 149 | iheight := hres + buffer[68]; 150 | if ((buffer[128]=10) and (buffer[132]=75) or 151 | (buffer[128]=1) and (buffer[132]=1) or 152 | (buffer[128]=1) and (buffer[132]=5) or 153 | (buffer[128]=1) and (buffer[132]=6) or 154 | ((buffer[128]=1) and (buffer[132]=15) and (ssize<14*MEGABYTE))) and 155 | (iwidth=720) and (iheight=480) then begin 156 | Result := True; 157 | exit; 158 | end; 159 | end; 160 | 161 | end; 162 | 163 | function Swap32(const Figure: Integer): Integer; 164 | var 165 | ByteArray: array [1..4] of Byte absolute Figure; 166 | begin 167 | { Swap 4 bytes } 168 | Result := 169 | Bytearray [1] * $1000000 + 170 | Bytearray [2] * $10000 + 171 | Bytearray [3] * $100 + 172 | Bytearray [4]; 173 | end; 174 | 175 | function GetTagSize(const Tag: ID3v2TagInfo): Integer; 176 | begin 177 | { Get total tag size } 178 | Result := 179 | Tag.Size[1] * $200000 + 180 | Tag.Size[2] * $4000 + 181 | Tag.Size[3] * $80 + 182 | Tag.Size[4] + 10; 183 | if Tag.Flags and $10 = $10 then Inc(Result, 10); 184 | if Result > Tag.FileSize then Result := 0; 185 | end; 186 | 187 | 188 | end. 189 | -------------------------------------------------------------------------------- /helper_filtering.pas: -------------------------------------------------------------------------------- 1 | { 2 | this file is part of Ares 3 | Aresgalaxy ( http://aresgalaxy.sourceforge.net ) 4 | 5 | This program is free software; you can redistribute it and/or 6 | modify it under the terms of the GNU General Public License 7 | as published by the Free Software Foundation; either 8 | version 2 of the License, or (at your option) any later version. 9 | 10 | This program is distributed in the hope that it will be useful, 11 | but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | GNU General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program; if not, write to the Free Software 17 | Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 18 | } 19 | 20 | { 21 | Description: 22 | some lame filtering (used by thread_client to filter some listing) 23 | TODO: add an importable file to allow custom filtering 24 | } 25 | 26 | unit helper_filtering; 27 | 28 | interface 29 | 30 | uses 31 | sysutils,classes2,classes,windows; 32 | 33 | function is_copyrighted_content(const key: string): Boolean; 34 | function is_teen_content(const key: string): Boolean; 35 | function str_isWebSpam(const strin: string): Boolean; 36 | function strip_spamcomments(comments: string): string; 37 | procedure init_keywfilter(const filterbranch: string; list: TMyStringList); 38 | function is_filtered_text(const lostr: string; filtered_strings: TMyStringList): Boolean; 39 | 40 | 41 | implementation 42 | 43 | uses 44 | helper_diskio,vars_global,const_ares; 45 | 46 | 47 | function is_filtered_text(const lostr: string; filtered_strings: TMyStringList): Boolean; 48 | var 49 | i: Integer; 50 | lofiltered: string; 51 | begin 52 | result := True; 53 | 54 | for i := 0 to filtered_strings.count-1 do begin 55 | lofiltered := filtered_strings[i]; 56 | 57 | if pos(lofiltered,lostr)<>0 then begin 58 | exit; 59 | end; 60 | 61 | end; 62 | 63 | Result := False; 64 | end; 65 | 66 | procedure init_keywfilter(const filterbranch: string; list: TMyStringList); 67 | var 68 | stream: Thandlestream; 69 | str,keywordstr: string; 70 | buffer: array [0..1023] of char; 71 | previous_len,red: Integer; 72 | begin 73 | 74 | if filterbranch='ChanListFilter' then begin 75 | with list do begin 76 | add('sex'); 77 | add('racis'); 78 | add('porn'); 79 | add('shemale'); 80 | add('fetish'); 81 | add('incest'); 82 | add('gangbang'); 83 | add('masochist'); 84 | add('razors'); 85 | end; 86 | end; 87 | 88 | stream := MyFileOpen(vars_global.app_path+'\Data\'+filterbranch+'.txt',ARES_READONLY_BUT_SEQUENTIAL); 89 | if stream=nil then exit; 90 | 91 | with stream do begin 92 | str := ''; 93 | while (position0 then begin 105 | 106 | if copy(str,1,3)=chr($ef)+chr($bb)+chr($bf) then delete(str,1,3); //strip utf-8 header 107 | while (pos('#',str)=1) do delete(str,1,pos(CRLF,str)+1); 108 | 109 | 110 | while (length(str)>0) do begin 111 | if pos(',',str)>0 then begin 112 | keywordstr := copy(str,1,pos(',',str)-1); 113 | delete(str,1,pos(',',str)); 114 | end else begin 115 | keywordstr := str; 116 | str := ''; 117 | end; 118 | list.add(keywordstr); 119 | end; 120 | end; 121 | 122 | 123 | end; 124 | 125 | 126 | function strip_spamcomments(comments: string): string; 127 | var 128 | locom: string; 129 | begin 130 | result := ''; 131 | locom := lowercase(comments); 132 | if pos('quickmusic',locom)=0 then 133 | if pos('supermusic',locom)=0 then 134 | if pos('elitemusic',locom)=0 then 135 | if pos('musictiger',locom)=0 then 136 | if pos('mp3finder',locom)=0 then 137 | if pos('mp3advance',locom)=0 then 138 | if pos('simplemp3',locom)=0 then 139 | if pos('popgal',locom)=0 then 140 | if pos('mp3',locom)=0 then 141 | if pos('.com',locom)=0 then 142 | if pos('www.',locom)=0 then 143 | Result := comments; 144 | end; 145 | 146 | function str_isWebSpam(const strin: string): Boolean; 147 | begin 148 | Result := False; 149 | if pos('.com',strin)<>0 then Result := true else 150 | if pos('www.',strin)<>0 then Result := true else 151 | if pos('http',strin)<>0 then Result := True; 152 | end; 153 | 154 | function is_copyrighted_content(const key: string): Boolean; 155 | begin 156 | 157 | if length(key)<12 then begin 158 | Result := False; 159 | exit; 160 | end; 161 | 162 | Result := True; 163 | 164 | if pos('nathan stone',key)<>0 then exit; 165 | 166 | Result := False; 167 | end; 168 | 169 | function is_teen_content(const key: string): Boolean; 170 | var 171 | lokey: string; 172 | begin 173 | 174 | if length(key)<=2 then begin 175 | Result := False; 176 | exit; 177 | end; 178 | Result := True; 179 | lokey := lowercase(key); 180 | if pos('teen',lokey)<>0 then exit else 181 | if pos('deflor',lokey)<>0 then exit else 182 | if pos('pedo',lokey)<>0 then exit else 183 | if pos('bambi',lokey)<>0 then exit else 184 | if pos('tiny',lokey)<>0 then exit else 185 | //if pos('r@ygold',lokey)<>0 then exit else 186 | //if pos('roygold',lokey)<>0 then exit else 187 | if pos('ygold',lokey)<>0 then exit else 188 | if pos('child',lokey)<>0 then exit else 189 | if pos('underage',lokey)<>0 then exit else 190 | if pos('kiddy',lokey)<>0 then exit else 191 | if pos('kiddie',lokey)<>0 then exit else 192 | if pos('lolita',lokey)<>0 then exit else 193 | if pos('incest',lokey)<>0 then exit else 194 | if pos('rape',lokey)<>0 then exit else 195 | if pos('legal',lokey)<>0 then exit else 196 | if pos('babysitter',lokey)<>0 then exit else 197 | if pos('1yo',lokey)<>0 then exit else 198 | if pos('2yo',lokey)<>0 then exit else 199 | if pos('3yo',lokey)<>0 then exit else 200 | if pos('4yo',lokey)<>0 then exit else 201 | if pos('5yo',lokey)<>0 then exit else 202 | if pos('6yo',lokey)<>0 then exit else 203 | if pos('7yo',lokey)<>0 then exit else 204 | if pos('8yo',lokey)<>0 then exit else 205 | if pos('9yo',lokey)<>0 then exit else 206 | if pos('0yo',lokey)<>0 then exit else 207 | if pos('petit',lokey)<>0 then exit; 208 | Result := False; 209 | end; 210 | 211 | end. -------------------------------------------------------------------------------- /helper_findmore.pas: -------------------------------------------------------------------------------- 1 | { 2 | this file is part of Ares 3 | Aresgalaxy ( http://aresgalaxy.sourceforge.net ) 4 | 5 | This program is free software; you can redistribute it and/or 6 | modify it under the terms of the GNU General Public License 7 | as published by the Free Software Foundation; either 8 | version 2 of the License, or (at your option) any later version. 9 | 10 | This program is distributed in the hope that it will be useful, 11 | but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | GNU General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program; if not, write to the Free Software 17 | Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 18 | } 19 | 20 | { 21 | Description: 22 | audio->find more of the same artist/genre, prepare search panel and start new search 23 | } 24 | 25 | unit helper_findmore; 26 | 27 | interface 28 | 29 | uses 30 | ares_types,comettrees; 31 | 32 | procedure mainGui_findartist_frombrowse; 33 | procedure mainGui_findgenre_frombrowse; 34 | procedure searchpanel_setfindmore_gen(genre: string); 35 | procedure searchpanel_setfindmore_art(artist: string); 36 | 37 | 38 | implementation 39 | 40 | uses 41 | ufrmmain,helper_search_gui,vars_global,helper_unicode,vars_localiz, 42 | const_ares,cometpageview; 43 | 44 | 45 | procedure searchpanel_setfindmore_gen(genre: string); 46 | begin 47 | with ares_frmmain do begin 48 | if not radio_srcmime_audio.checked then begin 49 | radio_srcmime_all.checked := False; 50 | radio_srcmime_audio.checked := True; 51 | radio_srcmime_video.checked := False; 52 | radio_srcmime_image.checked := False; 53 | radio_srcmime_document.checked := False; 54 | radio_srcmime_software.checked := False; 55 | ufrmmain.ares_frmmain.radiosearchmimeClick(nil); 56 | end; 57 | 58 | if widestrtoutf8str(label_more_searchopt.caption)=GetLangStringA(MORE_SEARCH_OPTION_STR) then ufrmmain.ares_frmmain.label_more_searchoptClick(nil); 59 | 60 | combotitsearch.text := ''; 61 | comboautsearch.text := ''; 62 | combocatsearch.text := utf8strtowidestr(genre); 63 | 64 | combodatesearch.text := ''; 65 | combo_lang_search.itemindex := 0; 66 | combo_sel_duration.itemindex := 0; 67 | combo_sel_quality.itemindex := 0; 68 | combo_sel_size.itemindex := 0; 69 | end; 70 | 71 | ufrmmain.ares_frmmain.Btn_start_searchclick(nil); 72 | end; 73 | 74 | 75 | procedure searchpanel_setfindmore_art(artist: string); 76 | begin 77 | with ares_frmmain do begin 78 | if not radio_srcmime_audio.checked then begin 79 | radio_srcmime_all.checked := False; 80 | radio_srcmime_audio.checked := True; 81 | radio_srcmime_video.checked := False; 82 | radio_srcmime_image.checked := False; 83 | radio_srcmime_document.checked := False; 84 | radio_srcmime_software.checked := False; 85 | ufrmmain.ares_frmmain.RadiosearchmimeClick(nil); 86 | end; 87 | 88 | if widestrtoutf8str(label_more_searchopt.caption)=GetLangStringA(MORE_SEARCH_OPTION_STR) then ufrmmain.ares_frmmain.label_more_searchoptClick(nil); 89 | 90 | 91 | combotitsearch.text := ''; 92 | comboautsearch.text := utf8strtowidestr(artist); 93 | combocatsearch.text := ''; 94 | 95 | combodatesearch.text := ''; 96 | combo_lang_search.itemindex := 0; 97 | combo_sel_duration.itemindex := 0; 98 | combo_sel_quality.itemindex := 0; 99 | combo_sel_size.itemindex := 0; 100 | end; 101 | 102 | ufrmmain.ares_frmmain.Btn_start_searchclick(nil); 103 | end; 104 | 105 | procedure mainGui_findgenre_frombrowse; 106 | begin 107 | end; 108 | 109 | procedure mainGui_findartist_frombrowse; 110 | begin 111 | end; 112 | 113 | end. 114 | -------------------------------------------------------------------------------- /helper_library_db.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CWBudde/AresGalaxy/b6136fd50c80f73be3115b315bb15bbbf9d1b528/helper_library_db.pas -------------------------------------------------------------------------------- /helper_manual_share.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CWBudde/AresGalaxy/b6136fd50c80f73be3115b315bb15bbbf9d1b528/helper_manual_share.pas -------------------------------------------------------------------------------- /helper_mimetypes.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CWBudde/AresGalaxy/b6136fd50c80f73be3115b315bb15bbbf9d1b528/helper_mimetypes.pas -------------------------------------------------------------------------------- /helper_params.pas: -------------------------------------------------------------------------------- 1 | { 2 | this file is part of Ares 3 | Aresgalaxy ( http://aresgalaxy.sourceforge.net ) 4 | 5 | This program is free software; you can redistribute it and/or 6 | modify it under the terms of the GNU General Public License 7 | as published by the Free Software Foundation; either 8 | version 2 of the License, or (at your option) any later version. 9 | 10 | This program is distributed in the hope that it will be useful, 11 | but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | GNU General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program; if not, write to the Free Software 17 | Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 18 | } 19 | 20 | { 21 | Description: 22 | used to extract widestring comand line parameters 23 | } 24 | 25 | unit helper_params; 26 | 27 | interface 28 | 29 | uses 30 | windows,tntsysutils; 31 | 32 | function WideParamStr(Index: Integer): WideString; 33 | function WideParamCount: Integer; 34 | function WideGetParamStr(P: PWideChar; var Param: WideString): PWideChar; 35 | function should_hide_in_params: Boolean; 36 | 37 | 38 | implementation 39 | 40 | function should_hide_in_params: Boolean; 41 | var 42 | i: Integer; 43 | begin 44 | Result := False; 45 | for I := 1 to wideParamCount do begin 46 | if wideparamstr(i)='-h' then begin 47 | Result := True; 48 | break; 49 | end; 50 | end; 51 | end; 52 | 53 | function WideParamCount: Integer; 54 | var 55 | P: PWideChar; 56 | S: WideString; 57 | begin 58 | P := WideGetParamStr(GetCommandLineW,S); 59 | Result := 0; 60 | while True do begin 61 | P := WideGetParamStr(P, S); 62 | if S = '' then Break; 63 | Inc(Result); 64 | end; 65 | end; 66 | 67 | function WideGetParamStr(P: PWideChar; var Param: WideString): PWideChar; 68 | var 69 | Len: Integer; 70 | Buffer: array [0..4095] of WideChar; 71 | begin 72 | while True do 73 | begin 74 | while (P[0] <> #0) and (P[0] <= ' ') do Inc(P); 75 | if (P[0] = '"') and (P[1] = '"') then Inc(P, 2) else Break; 76 | end; 77 | Len := 0; 78 | while (P[0] > ' ') and (Len < SizeOf(Buffer)) do 79 | if P[0] = '"' then 80 | begin 81 | Inc(P); 82 | while (P[0] <> #0) and (P[0] <> '"') do 83 | begin 84 | Buffer[Len] := P[0]; 85 | Inc(Len); 86 | Inc(P); 87 | end; 88 | if P[0] <> #0 then Inc(P); 89 | end else 90 | begin 91 | Buffer[Len] := P[0]; 92 | Inc(Len); 93 | Inc(P); 94 | end; 95 | SetString(Param, Buffer, Len); 96 | Result := P; 97 | end; 98 | 99 | function WideParamStr(Index: Integer): WideString; 100 | var 101 | P: PWideChar; 102 | begin 103 | if Index = 0 then 104 | Result := WideGetModuleFileName(0) 105 | else begin 106 | P := GetCommandLineW; 107 | while True do begin 108 | P := WideGetParamStr(P, Result); 109 | if (Index = 0) or (Result = '') then Break; 110 | Dec(Index); 111 | end; 112 | end; 113 | end; 114 | 115 | end. 116 | -------------------------------------------------------------------------------- /helper_playlist.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CWBudde/AresGalaxy/b6136fd50c80f73be3115b315bb15bbbf9d1b528/helper_playlist.pas -------------------------------------------------------------------------------- /helper_share_settings.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CWBudde/AresGalaxy/b6136fd50c80f73be3115b315bb15bbbf9d1b528/helper_share_settings.pas -------------------------------------------------------------------------------- /helper_sockets.pas: -------------------------------------------------------------------------------- 1 | { 2 | this file is part of Ares 3 | Aresgalaxy ( http://aresgalaxy.sourceforge.net ) 4 | 5 | This program is free software; you can redistribute it and/or 6 | modify it under the terms of the GNU General Public License 7 | as published by the Free Software Foundation; either 8 | version 2 of the License, or (at your option) any later version. 9 | 10 | This program is distributed in the hope that it will be useful, 11 | but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | GNU General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program; if not, write to the Free Software 17 | Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 18 | } 19 | 20 | { 21 | Description: 22 | some helpfull socket functions and classes 23 | } 24 | 25 | unit helper_sockets; 26 | 27 | interface 28 | 29 | uses 30 | classes,blcksock,ares_types,windows,sysutils,winsock,vars_global; 31 | 32 | const 33 | SOCKET_ERROR = -1; 34 | 35 | procedure assign_proxy_settings(socket: Ttcpblocksocket); 36 | function probe_socket(socket:integer): Boolean; 37 | 38 | implementation 39 | 40 | uses 41 | ufrmmain; 42 | 43 | function probe_socket(socket:integer): Boolean; 44 | var er: Integer; 45 | buffer: array [0..1] of char; 46 | begin 47 | if not TCPSocket_CanRead(socket,0,er) then begin 48 | Result := ((er=0) or (er=WSAEWOULDBLOCK)); 49 | end else begin 50 | TCPSocket_RecvBuffer(socket,@buffer,1,er); 51 | Result := ((er=0) or (er=WSAEWOULDBLOCK)); 52 | end; 53 | end; 54 | 55 | procedure assign_proxy_settings(socket: Ttcpblocksocket); 56 | begin 57 | if vars_global.socks_type=SocTNone then begin 58 | socket.SocksIP := ''; 59 | socket.SocksPort := '0'; 60 | end else begin 61 | socket.FLastTime := gettickcount; //per vari timeout in TCPSocket_connesso() 62 | socket.SocksIp := vars_global.socks_ip; 63 | socket.SocksPort := inttostr(vars_global.socks_port); 64 | if vars_global.socks_type=SocTSock5 then begin 65 | socket.SocksType := ST_Socks5; 66 | socket.SocksUsername := vars_global.socks_username; 67 | socket.SocksPassword := vars_global.socks_password; 68 | end else socket.SocksType := ST_Socks4; 69 | socket.FStatoConn := PROXY_InConnessione; 70 | end; 71 | end; 72 | 73 | 74 | end. 75 | -------------------------------------------------------------------------------- /helper_strings.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CWBudde/AresGalaxy/b6136fd50c80f73be3115b315bb15bbbf9d1b528/helper_strings.pas -------------------------------------------------------------------------------- /helper_upnp.pas: -------------------------------------------------------------------------------- 1 | unit helper_upnp; 2 | 3 | interface 4 | 5 | uses 6 | windows,sysutils,ComObj,Variants,ActiveX; 7 | 8 | type 9 | TUPnP_PortMapTable = class 10 | public 11 | class function add(const active: Boolean; const extPort, intPort: DWORD; 12 | const ip, proto, desc: String): Boolean; 13 | class function remove(const extPort: DWORD; const proto: String): Boolean; 14 | end; 15 | 16 | procedure map_ports; 17 | procedure unmap_ports; 18 | 19 | implementation 20 | 21 | uses 22 | ufrmmain,vars_global; 23 | 24 | procedure map_ports; 25 | begin 26 | TUPnP_PortMapTable.remove(vars_global.myport, 'tcp'); 27 | TUPnP_PortMapTable.remove(vars_global.myport, 'udp'); 28 | // TUPnP_PortMapTable.remove(vars_global.myport+1, 'udp'); 29 | 30 | TUPnP_PortMapTable.add(true, vars_global.myport, vars_global.myport, vars_global.LocalIP, 'TCP', 'AresTCP'); 31 | TUPnP_PortMapTable.add(true, vars_global.myport, vars_global.myport, vars_global.LocalIP, 'UDP', 'AresUDP'); 32 | end; 33 | 34 | procedure unmap_ports; 35 | begin 36 | TUPnP_PortMapTable.remove(vars_global.myport, 'tcp'); 37 | TUPnP_PortMapTable.remove(vars_global.myport, 'udp'); 38 | end; 39 | 40 | class function TUPnP_PortMapTable.add(const active: Boolean; const extPort, intPort: DWORD; 41 | const ip, proto, desc: String): Boolean; 42 | var 43 | n, p: Variant; 44 | Begin 45 | Result := False; 46 | try 47 | n := CreateOleObject('HNetCfg.NATUPnP'); 48 | p := n.StaticPortMappingCollection; 49 | if not VarIsClear(p) then 50 | begin 51 | p.Add(extPort, UpperCase(proto), intPort, ip, active, desc); 52 | Result := True; 53 | end; 54 | except 55 | // on e: exception do showmessage(e.Message); 56 | end; 57 | end; 58 | 59 | class function TUPnP_PortMapTable.remove(const extPort: DWORD; const proto: String): Boolean; 60 | var 61 | n, p: Variant; 62 | Begin 63 | Result := False; 64 | try 65 | n := CreateOleObject('HNetCfg.NATUPnP'); 66 | p := n.StaticPortMappingCollection; 67 | if not VarIsClear(p) then 68 | Result := p.Remove(extPort, UpperCase(proto)) = S_OK; 69 | except 70 | // on e: exception do showmessage(e.Message); 71 | end; 72 | end; 73 | 74 | end. -------------------------------------------------------------------------------- /helper_visual_library.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CWBudde/AresGalaxy/b6136fd50c80f73be3115b315bb15bbbf9d1b528/helper_visual_library.pas -------------------------------------------------------------------------------- /infback.obj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CWBudde/AresGalaxy/b6136fd50c80f73be3115b315bb15bbbf9d1b528/infback.obj -------------------------------------------------------------------------------- /inffast.obj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CWBudde/AresGalaxy/b6136fd50c80f73be3115b315bb15bbbf9d1b528/inffast.obj -------------------------------------------------------------------------------- /inflate.obj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CWBudde/AresGalaxy/b6136fd50c80f73be3115b315bb15bbbf9d1b528/inflate.obj -------------------------------------------------------------------------------- /inftrees.obj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CWBudde/AresGalaxy/b6136fd50c80f73be3115b315bb15bbbf9d1b528/inftrees.obj -------------------------------------------------------------------------------- /peerguard.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CWBudde/AresGalaxy/b6136fd50c80f73be3115b315bb15bbbf9d1b528/peerguard.pas -------------------------------------------------------------------------------- /thread_client.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CWBudde/AresGalaxy/b6136fd50c80f73be3115b315bb15bbbf9d1b528/thread_client.pas -------------------------------------------------------------------------------- /thread_download.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CWBudde/AresGalaxy/b6136fd50c80f73be3115b315bb15bbbf9d1b528/thread_download.pas -------------------------------------------------------------------------------- /thread_share.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CWBudde/AresGalaxy/b6136fd50c80f73be3115b315bb15bbbf9d1b528/thread_share.pas -------------------------------------------------------------------------------- /thread_supernode.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CWBudde/AresGalaxy/b6136fd50c80f73be3115b315bb15bbbf9d1b528/thread_supernode.pas -------------------------------------------------------------------------------- /thread_terminator.pas: -------------------------------------------------------------------------------- 1 | { 2 | this file is part of Ares 3 | Aresgalaxy ( http://aresgalaxy.sourceforge.net ) 4 | 5 | This program is free software; you can redistribute it and/or 6 | modify it under the terms of the GNU General Public License 7 | as published by the Free Software Foundation; either 8 | version 2 of the License, or (at your option) any later version. 9 | 10 | This program is distributed in the hope that it will be useful, 11 | but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | GNU General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program; if not, write to the Free Software 17 | Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 18 | } 19 | 20 | { 21 | Description: 22 | if anything goes wrong don't leave Ares running(freezed) in taskmanager 23 | } 24 | 25 | unit thread_terminator; 26 | 27 | interface 28 | uses classes,windows,tntwindows; 29 | 30 | type 31 | tthread_terminator = class(tthread) 32 | protected 33 | procedure execute; override; 34 | private 35 | ffast: Boolean; 36 | public 37 | property fast:boolean read ffast write ffast default False; 38 | end; 39 | 40 | implementation 41 | 42 | procedure tthread_terminator.execute; 43 | var 44 | i: Byte; 45 | id:hwnd; 46 | code: Cardinal; 47 | begin 48 | freeonterminate := True; 49 | priority := tphighest; 50 | code := 0; 51 | 52 | if not ffast then begin 53 | 54 | i := 0; 55 | while (i<60) do begin 56 | if not terminated then sleep(500) else break; 57 | inc(i); 58 | end; 59 | 60 | end else i := 60; 61 | 62 | if i>=59 then begin 63 | try 64 | id := getcurrentprocess; 65 | while not terminateprocess(id,code) do sleep(10); 66 | except 67 | end; 68 | end else freeonterminate := False; 69 | 70 | end; 71 | 72 | end. 73 | -------------------------------------------------------------------------------- /thread_upload.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CWBudde/AresGalaxy/b6136fd50c80f73be3115b315bb15bbbf9d1b528/thread_upload.pas -------------------------------------------------------------------------------- /trees.obj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CWBudde/AresGalaxy/b6136fd50c80f73be3115b315bb15bbbf9d1b528/trees.obj -------------------------------------------------------------------------------- /types_supernode.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CWBudde/AresGalaxy/b6136fd50c80f73be3115b315bb15bbbf9d1b528/types_supernode.pas -------------------------------------------------------------------------------- /uWhatImListeningTo.pas: -------------------------------------------------------------------------------- 1 | { 2 | this file is part of Ares 3 | Aresgalaxy ( http://aresgalaxy.sourceforge.net ) 4 | 5 | This program is free software; you can redistribute it and/or 6 | modify it under the terms of the GNU General Public License 7 | as published by the Free Software Foundation; either 8 | version 2 of the License, or (at your option) any later version. 9 | 10 | This program is distributed in the hope that it will be useful, 11 | but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | GNU General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program; if not, write to the Free Software 17 | Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 18 | } 19 | 20 | unit uWhatImListeningTo; 21 | 22 | interface 23 | 24 | uses 25 | windows,umediar; 26 | 27 | procedure UpdateWhatImListeningTo(strTitle,strArtist,strAlbum: string; enabled:boolean = true); overload; 28 | procedure UpdateWhatImListeningTo(strIn: string; radioName: string); overload; 29 | procedure UpdateWhatImListeningTo(mp3: TmpegAudio); overload; 30 | function StripMsnIllegalChars(strIn: string): string; 31 | 32 | // var 33 | // stringBuffer: array [0..127] of WideChar; 34 | 35 | implementation 36 | 37 | uses 38 | const_win_messages,ufrmMain,sysutils,vars_global,helper_strings,helper_registry,helper_channellist,const_ares; 39 | 40 | 41 | procedure UpdateWhatImListeningTo(mp3: TmpegAudio); 42 | var 43 | title,artist,album: string; 44 | begin 45 | if not vars_global.check_opt_chat_whatsong_checked then exit; 46 | 47 | title := ''; 48 | artist := ''; 49 | album := ''; 50 | 51 | if mp3.Valid then begin 52 | 53 | if mp3.ID3v2.Exists then begin 54 | title := mp3.id3v2.title; 55 | artist := mp3.id3v2.artist; 56 | album := mp3.id3v2.album; 57 | end; 58 | 59 | if mp3.ID3v1.Exists then begin 60 | if length(title)=0 then title := mp3.id3v1.title; 61 | if length(artist)=0 then artist := mp3.id3v1.artist; 62 | if length(album)=0 then album := mp3.id3v1.album; 63 | end; 64 | 65 | end; 66 | 67 | if ((length(title)=0) or 68 | (length(artist)=0)) then UpdateWhatImListeningTo(vars_global.caption_player,'') 69 | else begin 70 | vars_global.caption_player := artist+' - '+title; 71 | UpdateWhatImListeningTo(title,artist,''); 72 | end; 73 | end; 74 | 75 | procedure UpdateWhatImListeningTo(strIn: string; radioName: string); 76 | var 77 | ind: Integer; 78 | artist,title: string; 79 | begin 80 | if not vars_global.check_opt_chat_whatsong_checked then exit; 81 | 82 | strIn := StripMsnIllegalChars(strIn); 83 | radioName := StripMsnIllegalChars(radioName); 84 | 85 | ind := pos(' - ',strIn); 86 | 87 | if ind>0 then begin 88 | artist := Trim(copy(strIn,1,ind-1)); 89 | title := Trim(copy(strIn,ind+3,length(strIn))); 90 | 91 | if length(title)=0 then begin 92 | title := copy(radioName,1,30); 93 | end; 94 | 95 | UpdateWhatImListeningTo(title,artist,''); 96 | end else begin 97 | if strIn='' then UpdateWhatImListeningTo(radioName,'','') 98 | else UpdateWhatImListeningTo(strIn,'',''); 99 | end; 100 | 101 | end; 102 | 103 | function StripMsnIllegalChars(strIn: string): string; 104 | begin 105 | result := strIn; 106 | 107 | while (pos('\0',result)>0) do 108 | Result := copy(result,1,pos('\0',result)-1) + 109 | copy(result,pos('\0',result)+2,length(result)); 110 | 111 | while (pos('http://',lowercase(result))>0) do 112 | Result := copy(result,1,pos('http://',lowercase(result))-1)+ 113 | copy(result,pos('http://',lowercase(result))+7,length(result)); 114 | 115 | end; 116 | 117 | procedure UpdateWhatImListeningTo(strTitle,strArtist,strAlbum: string; enabled:boolean = true); 118 | var 119 | //handleMSN: THandle; 120 | // structCopy: TCopyDataStruct; 121 | stringChat: string; 122 | begin 123 | 124 | // Flush the array. 125 | // FillChar(stringBuffer,SizeOf(stringBuffer),#0); 126 | 127 | strTitle := Trim(copy(strTitle,1,90)); 128 | strArtist := Trim(copy(strArtist,1,90)); 129 | stralbum := Trim(copy(strAlbum,1,90)); 130 | stringChat := ''; 131 | // The first Music can be changed to Games, Office, or Empty. 132 | if ((length(strTitle)>0) and (length(strArtist)>0) and (length(strAlbum)>0)) then begin 133 | // StringToWideChar('\0Music\0'+inttostr(integer(enabled))+'\0'+'{1} - {2} - {0}'+'\0'+strTitle+'\0'+strArtist+'\0'+strAlbum+'\0'+'WMContentID'+#0,@stringBuffer[0],128); 134 | stringChat := strTitle+' - '+strArtist+' - '+strAlbum; 135 | end else 136 | if ((length(strTitle)>0) and (length(strArtist)>0)) then begin 137 | // StringToWideChar('\0Music\0'+inttostr(integer(enabled))+'\0'+'{1} - {0}'+'\0'+strTitle+'\0'+strArtist+'\0'+'WMContentID'+#0,@stringBuffer[0],128); 138 | stringChat := strTitle+' - '+strArtist; 139 | end else begin 140 | if length(strTitle)>0 then begin 141 | // StringToWideChar('\0Music\0'+inttostr(integer(enabled))+'\0'+'{0} {1}'+'\0'+strTitle+'\0\0WMContentID'+#0,@stringBuffer[0],128); 142 | stringChat := strTitle; 143 | end else 144 | if length(strArtist)>0 then begin 145 | // StringToWideChar('\0Music\0'+inttostr(integer(enabled))+'\0'+'{1} {0}'+'\0\0'+strArtist+'\0WMContentID'+#0,@stringBuffer[0],128); 146 | stringChat := strArtist; 147 | end else begin 148 | if enabled then exit; 149 | // StringToWideChar('\0Music\0'+inttostr(integer(enabled))+'\0'+'{1} {0}'+'\0\0\0WMContentID'+#0,@stringBuffer[0],128); 150 | stringChat := ''; 151 | end; 152 | end; 153 | 154 | //if list_chatchan_visual.count>0 then begin //send this in chatrooms as well 155 | if high(ares_frmmain.panel_chat.panels)>0 then begin 156 | if length(stringChat)>0 then helper_channellist.broadCastChildChatrooms('PERSMSG'+chr(7)+stringChat+CHRNULL) 157 | else helper_channellist.broadCastChildChatrooms('PERSMSG'+get_regString('Personal.CustomMessage')+CHRNULL); 158 | end; 159 | 160 | { // Set up the structure to hold the WM_COPYDATA and set the values. 161 | FillChar(structCopy,SizeOf(TCopyDataStruct),#0); 162 | with structCopy do 163 | begin 164 | cbData := SizeOf(stringBuffer); 165 | dwData := $547; 166 | lpData := @stringBuffer[0]; 167 | end; 168 | 169 | // Iterate through (for poloygamy) the MSN windows sending WM_COPYDATA to each 170 | handleMSN := FindWindowEx(0,0,'MsnMsgrUIManager',nil); 171 | while handleMSN <> 0 do 172 | begin 173 | SendMessage(handleMSN,WM_COPYDATA,0,Integer(@structCopy)); 174 | 175 | handleMSN := FindWindowEx(0,handleMSN,'MsnMsgrUIManager',nil); 176 | end; } 177 | end; 178 | 179 | end. 180 | -------------------------------------------------------------------------------- /uctrvol.dfm: -------------------------------------------------------------------------------- 1 | object frmctrlvol: Tfrmctrlvol 2 | Left = 215 3 | Top = 159 4 | BiDiMode = bdLeftToRight 5 | BorderIcons = [] 6 | BorderStyle = bsNone 7 | ClientHeight = 220 8 | ClientWidth = 115 9 | Color = clBtnFace 10 | ParentFont = True 11 | FormStyle = fsStayOnTop 12 | OldCreateOrder = False 13 | ParentBiDiMode = False 14 | Scaled = False 15 | OnClose = FormClose 16 | OnCreate = FormCreate 17 | OnDeactivate = FormDeactivate 18 | OnMouseDown = FormMouseDown 19 | OnMouseMove = FormMouseMove 20 | OnMouseUp = FormMouseUp 21 | OnPaint = FormPaint 22 | OnShow = FormShow 23 | PixelsPerInch = 96 24 | TextHeight = 13 25 | object btn_close: TXPbutton 26 | Left = 55 27 | Top = 8 28 | Width = 20 29 | Height = 21 30 | BevelOuter = bvNone 31 | caption = 'X' 32 | enabled = True 33 | font.Charset = DEFAULT_CHARSET 34 | font.Color = clBlack 35 | font.Height = -11 36 | font.Name = 'Tahoma' 37 | font.Pitch = fpFixed 38 | font.Style = [] 39 | ParentFont = False 40 | ParentShowHint = False 41 | ShowHint = False 42 | TabOrder = 1 43 | OnClick = btn_closeClick 44 | index_down = 2 45 | index_over = 2 46 | index_off = 2 47 | textleft = 7 48 | texttop = 3 49 | imgleft = 7 50 | imgtop = 3 51 | colorbg = clBtnFace 52 | Down = False 53 | state = [csEnabled] 54 | end 55 | object CheckBox1: TTntCheckBox 56 | Left = 13 57 | Top = 192 58 | Width = 60 59 | Height = 17 60 | Caption = 'Mute' 61 | TabOrder = 0 62 | OnClick = CheckBox1Click 63 | end 64 | end 65 | -------------------------------------------------------------------------------- /uflvplayer.pas: -------------------------------------------------------------------------------- 1 | { 2 | this file is part of Ares 3 | Aresgalaxy ( http://aresgalaxy.sourceforge.net ) 4 | 5 | This program is free software; you can redistribute it and/or 6 | modify it under the terms of the GNU General Public License 7 | as published by the Free Software Foundation; either 8 | version 2 of the License, or (at your option) any later version. 9 | 10 | This program is distributed in the hope that it will be useful, 11 | but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | GNU General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program; if not, write to the Free Software 17 | Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 18 | } 19 | 20 | { 21 | Description: 22 | control unit of flvplayer.swf: plays flv and mp4 files 23 | } 24 | 25 | unit uflvplayer; 26 | 27 | interface 28 | 29 | uses 30 | ShockwaveEx,windows,classes,sysutils; 31 | 32 | procedure init_flv_player(const filename: WideString); 33 | procedure freePlayer(sender: TObject); 34 | //function copyFLVPlayer(const filename: WideString; const thepath: WideString): Boolean; 35 | 36 | var 37 | FLVPlayer: TShockwaveFlashEx; 38 | FLVLength: Int64; 39 | FLVPosition: Int64; 40 | FLVWidth: Integer; 41 | FLVHeight: Integer; 42 | FLVGeometry:double; 43 | 44 | implementation 45 | 46 | {$R flvplayer.res} 47 | 48 | uses 49 | umediar,helper_diskio,vars_global,ufrmmain,ares_types,helper_strings, 50 | const_ares,helper_player,helper_datetime,helper_gui_misc,helper_urls; 51 | 52 | 53 | procedure freePlayer(sender: TObject); 54 | begin 55 | FLVPlayer.OnFSCommand := nil; 56 | 57 | FreeAndNil(FLVPlayer); 58 | if imgscnlogo<>nil then imgscnlogo.visible := True; 59 | ares_frmmain.trackbar_player.position := 0; 60 | if sender<>nil then stopped_by_user := True; 61 | ares_frmmain.MPlayerPanel1.Playing := False; 62 | ares_frmmain.trackbar_player.TrackbarEnabled := False; 63 | ares_frmmain.trackbar_player.max := 0; 64 | ares_frmmain.mplayerpanel1.TimeCaption := ''; 65 | FLVLength := 0; 66 | FLVPosition := 0; 67 | 68 | end; 69 | 70 | {function copyFLVPlayer(const filename: WideString; const thepath: WideString): Boolean; 71 | var 72 | streamIn,streamOut: Thandlestream; 73 | len: Integer; 74 | buffeR: array [0..1023] of Byte; 75 | begin 76 | result := False; 77 | try 78 | if not fileexistsW(thepath) then begin 79 | if not fileexistsW(app_path+'\data\flvplayer.swf') then exit; 80 | 81 | streamin := myfileopen(app_path+'\data\flvplayer.swf',ARES_READONLY_ACCESS); 82 | streamout := myfileopen(thepath,ARES_OVERWRITE_EXISTING); 83 | if streamin=nil then exit; 84 | if streamout=nil then exit; 85 | 86 | while (streamin.positionsizeof(buffer) then break; 90 | end; 91 | 92 | FreeHandleStream(streamIn); 93 | FreeHandleStream(streamOut); 94 | end; 95 | 96 | result := True; 97 | except 98 | end; 99 | end; } 100 | 101 | 102 | procedure init_flv_player(const filename: WideString); 103 | var 104 | rs: TResourceStream; 105 | begin 106 | if FLVPlayer<>nil then begin 107 | //FlvPlayer.Stop; 108 | FreeAndNil(FLVPlayer); 109 | end; 110 | 111 | try 112 | FLVLength := 0; 113 | FLVPosition := 0; 114 | FLVGeometry := 1.333333333333333; //4:3 115 | 116 | if ares_frmmain.tabs_pageview.activePage=IDTAB_SCREEN then ares_frmmain.panel_screen.visible := False; 117 | //ares_frmmain.tabs_pageview.activePage := IDTAB_WEB; 118 | FLVPlayer := TShockwaveFlashEx.create(nil); 119 | FLVPlayer.BackgroundColor := 0; 120 | if FindResource(hInstance, 'flvplayer', RT_RCDATA)=0 then begin 121 | //amf.RTMP_Log('init_flv_player can''t find resource'); 122 | FreeAndNil(FLVPlayer); 123 | exit; 124 | end; 125 | rs := TResourceStream.Create(hInstance, 'flvplayer', RT_RCDATA); 126 | rs.Position := 0; 127 | FLVPlayer.LoadMovieFromStream(rs); 128 | rs.Free; 129 | { 130 | with FLVPlayer do begin 131 | parent := ares_frmmain.panel_vid; 132 | 133 | ScaleMode := 7; 134 | width := 640; //425; //480; 135 | height := 480; //325; //300; 136 | Quality := 3; 137 | left := (ares_frmmain.panel_vid.width div 2)-(width div 2); //212; 138 | top := (ares_frmmain.panel_vid.height div 2)-(height div 2); //162; 139 | Menu := False; 140 | Loop := False; 141 | OnFSCommand := ufrmmain.ares_frmmain.FlashPlayerFSCommand; 142 | Movie := thepath; 143 | SetVariable('file',flashize_Filename(filename)); 144 | end; } 145 | 146 | with FLVPlayer do begin 147 | parent := ares_frmmain.panel_vid; 148 | scale := '2'; 149 | ScaleMode := 2; //0 - ShowAll, 1 - NoBorder, 2 - ExactFit, 3 - NoScale, 4 - Low, 5 - AutoLow, 6 - AutoHight, 7 - Hight, 8 - Best, 9 - AutoMedium, 10 - Medium 150 | width := ares_frmmain.panel_vid.width; //dwidth; //425; //480; 151 | height := ares_frmmain.panel_vid.height; //dheight; //325; //300; 152 | Quality := 3; 153 | AllowFullScreen := 'True'; 154 | //AllowFullScreenInteractive := 'true'; 155 | left := (ares_frmmain.panel_vid.width div 2)-(width div 2);; //212; 156 | top := (ares_frmmain.panel_vid.height div 2)-(height div 2); //162; 157 | SAlign := 'LTRB'; // align scale LR, LT, TR, LTR, LB, RB, LRB, TB, LTB, TRB, LTRB 158 | Menu := False; 159 | Loop := False; 160 | wmode := 'transparent'; 161 | OnFSCommand := ufrmmain.ares_frmmain.FlashPlayerFSCommand; 162 | //Movie := app_path+'\Data\flvplayer.swf'; //thepath; 163 | //Movie := thepath; 164 | //SetVariable('flashvars','file='+extractfilename(filename)); 165 | // SetVariable('file',flashize_Filename(filename)); 166 | //SetVariable('autostart','true'); 167 | SetVariable('file',flashize_Filename(filename)); 168 | end; 169 | 170 | 171 | if imgscnlogo<>nil then imgscnlogo.visible := False; 172 | 173 | ares_frmmain.tabs_pageview.activePage := IDTAB_SCREEN; 174 | ares_frmmain.panel_screen.visible := True; 175 | 176 | caption_player := helper_strings.get_player_displayname(filename,'.flv'); 177 | ares_frmmain.mplayerpanel1.wcaption := caption_player; 178 | isvideoplaying := True; 179 | 180 | helper_player.player_actualfile := filename; 181 | 182 | player_resettrackbar; 183 | 184 | ares_frmmain.trackbar_player.OnChanged := nil; 185 | ares_frmmain.trackbar_player.max := FLVLength; 186 | ares_frmmain.trackbar_player.Position := uflvplayer.FLVPosition; 187 | ares_frmmain.trackbar_player.OnChanged := ufrmmain.ares_frmmain.trackbar_playerChange; 188 | 189 | ares_frmmain.MPlayerPanel1.Playing := True; 190 | 191 | player_get_volumesettings; 192 | ares_frmmain.mplayerpanel1.TimeCaption := format_time(0)+' / '+ 193 | format_time(FLVLength div 1000); 194 | 195 | 196 | except 197 | end; 198 | end; 199 | 200 | 201 | 202 | 203 | end. -------------------------------------------------------------------------------- /ufrmabout.pas: -------------------------------------------------------------------------------- 1 | unit ufrmabout; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 | Dialogs, StdCtrls, ExtCtrls, TntStdCtrls; 8 | 9 | type 10 | Tfrmabout = class(TForm) 11 | lbl_opt_gen_and: TLabel; 12 | lbl_opt_gen_eula: TLabel; 13 | lbl_opt_gen_privacy: TLabel; 14 | lbl_opt_homepage: TLabel; 15 | Image1: TImage; 16 | TntButton1: TTntButton; 17 | label_version: TLabel; 18 | Memo1: TMemo; 19 | procedure FormClose(Sender: TObject; var Action: TCloseAction); 20 | procedure lbl_opt_homepageClick(Sender: TObject); 21 | procedure lbl_opt_homepageMouseLeave(Sender: TObject); 22 | procedure lbl_opt_homepageMouseEnter(Sender: TObject); 23 | procedure lbl_opt_gen_privacyClick(Sender: TObject); 24 | procedure lbl_opt_gen_eulaClick(Sender: TObject); 25 | procedure FormShow(Sender: TObject); 26 | procedure TntButton1Click(Sender: TObject); 27 | procedure FormDeactivate(Sender: TObject); 28 | 29 | private 30 | { Private declarations } 31 | public 32 | { Public declarations } 33 | end; 34 | 35 | var 36 | frmabout: Tfrmabout; 37 | 38 | implementation 39 | 40 | uses 41 | utility_ares,const_ares,ufrmmain; 42 | 43 | {$R *.dfm} 44 | 45 | procedure Tfrmabout.FormClose(Sender: TObject; var Action: TCloseAction); 46 | begin 47 | action := caFree; 48 | end; 49 | 50 | procedure Tfrmabout.lbl_opt_homepageMouseLeave(Sender: TObject); 51 | begin 52 | (sender as TLabel).font.style := []; 53 | end; 54 | 55 | procedure Tfrmabout.lbl_opt_homepageMouseEnter(Sender: TObject); 56 | begin 57 | (sender as TLabel).font.style := [fsUnderline]; 58 | end; 59 | 60 | procedure Tfrmabout.lbl_opt_homepageClick(Sender: TObject); 61 | begin 62 | utility_ares.browser_go(STR_DEFAULT_WEBSITE); 63 | end; 64 | 65 | procedure Tfrmabout.lbl_opt_gen_privacyClick(Sender: TObject); 66 | begin 67 | utility_ares.browser_go(STR_PRIVACYPOLICY_WEBSITE); 68 | end; 69 | 70 | procedure Tfrmabout.lbl_opt_gen_eulaClick(Sender: TObject); 71 | begin 72 | utility_ares.browser_go(STR_EULA_WEBSITE); 73 | end; 74 | 75 | procedure Tfrmabout.FormShow(Sender: TObject); 76 | begin 77 | lbl_opt_homepage.caption := const_ares.STR_DEFAULT_WEBSITE; 78 | label_version.caption := 'You are running Ares version '+const_ares.ARES_VERS; 79 | //image1.Picture := imgscnlogo.Picture; 80 | end; 81 | 82 | procedure Tfrmabout.TntButton1Click(Sender: TObject); 83 | begin 84 | close; 85 | end; 86 | 87 | procedure Tfrmabout.FormDeactivate(Sender: TObject); 88 | begin 89 | close; 90 | end; 91 | 92 | end. 93 | -------------------------------------------------------------------------------- /ufrmhint.dfm: -------------------------------------------------------------------------------- 1 | object frmhint: Tfrmhint 2 | Left = 355 3 | Top = 202 4 | BiDiMode = bdLeftToRight 5 | BorderIcons = [] 6 | BorderStyle = bsNone 7 | Caption = 'Ares' 8 | ClientHeight = 29 9 | ClientWidth = 115 10 | Color = clInfoBk 11 | DefaultMonitor = dmDesktop 12 | ParentFont = True 13 | FormStyle = fsStayOnTop 14 | OldCreateOrder = False 15 | ParentBiDiMode = False 16 | Position = poDefault 17 | PrintScale = poNone 18 | Scaled = False 19 | OnCreate = FormCreate 20 | OnDestroy = FormDestroy 21 | OnMouseDown = FormMouseDown 22 | OnResize = FormResize 23 | PixelsPerInch = 96 24 | TextHeight = 13 25 | end 26 | -------------------------------------------------------------------------------- /ufrmhint.pas: -------------------------------------------------------------------------------- 1 | { 2 | this file is part of Ares 3 | Aresgalaxy ( http://aresgalaxy.sourceforge.net ) 4 | 5 | This program is free software; you can redistribute it and/or 6 | modify it under the terms of the GNU General Public License 7 | as published by the Free Software Foundation; either 8 | version 2 of the License, or (at your option) any later version. 9 | 10 | This program is distributed in the hope that it will be useful, 11 | but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | GNU General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program; if not, write to the Free Software 17 | Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 18 | } 19 | 20 | { 21 | Description: 22 | the 'bighint' window topmost and with an eyecandy transparency on 2k/XP platforms 23 | } 24 | 25 | unit ufrmhint; 26 | 27 | interface 28 | 29 | uses 30 | Windows, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 31 | ExtCtrls, StdCtrls,comettrees,messages,ares_types; 32 | 33 | type 34 | Tfrmhint = class(tform) 35 | procedure FormMouseDown(Sender: TObject; Button: TMouseButton; 36 | Shift: TShiftState; X, Y: Integer); 37 | procedure FormCreate(Sender: TObject); 38 | procedure FormResize(Sender: TObject); 39 | procedure FormDestroy(Sender: TObject); 40 | private 41 | procedure WMEraseBkgnd(Var Msg : TMessage); message WM_ERASEBKGND; 42 | public 43 | posXgraph: Integer; 44 | posYgraph: Integer; 45 | GraphWidth: Integer; 46 | bitMapGraph: TBitmap; 47 | procedure appear; 48 | procedure blend; 49 | end; 50 | 51 | var 52 | frmhint: Tfrmhint; 53 | 54 | 55 | implementation 56 | 57 | uses 58 | ufrmmain,vars_global,utility_ares,helper_bighints,const_ares; 59 | 60 | {$R *.DFM} 61 | 62 | procedure tfrmhint.WMEraseBkgnd(Var Msg : TMessage); 63 | begin 64 | msg.result := 1; 65 | end; 66 | 67 | 68 | procedure Tfrmhint.FormCreate(Sender: TObject); 69 | begin 70 | alphablendvalue := 230; 71 | alphablend := True; 72 | posXgraph := 14; 73 | GraphWidth := self.width-12; 74 | bitMapGraph := TBitmap.create; 75 | with bitMapGraph do begin 76 | pixelformat := pf24bit; 77 | width := self.width-2; 78 | height := 44; 79 | end; 80 | 81 | end; 82 | 83 | procedure tfrmhint.appear; 84 | var 85 | i: Integer; 86 | begin 87 | 88 | try 89 | 90 | for i := 3 to 23 do begin 91 | alphablendvalue := i*10; 92 | sleep(8); 93 | end; 94 | 95 | except 96 | end; 97 | end; 98 | 99 | procedure tfrmhint.blend; 100 | begin 101 | alphablendvalue := 1; 102 | end; 103 | 104 | procedure Tfrmhint.FormMouseDown(Sender: TObject; Button: TMouseButton; 105 | Shift: TShiftState; X, Y: Integer); 106 | var 107 | punto,punto1: TPoint; 108 | nodo:pCmtVnode; 109 | src:precord_panel_search; 110 | i: Integer; 111 | begin 112 | getcursorpos(punto); 113 | 114 | try 115 | 116 | if ares_frmmain.tabs_pageview.activepage=IDTAB_SEARCH then begin 117 | for i := 0 to src_panel_list.count-1 do begin 118 | src := src_panel_list[i]; 119 | if src^.containerPanel<>ares_frmmain.pagesrc.activepanel then continue; 120 | 121 | punto1 := src^.listview.screentoclient(punto); 122 | nodo := src^.listview.GetNodeAt(punto1.x,punto1.y); 123 | if nodo<>nil then begin 124 | setwindowpos(ares_FrmMain.handle,HWND_NOTOPMOST,0,0,0,0,SWP_NOMOVE or SWP_NOSIZE or SWP_NOOWNERZORDER); 125 | src^.listview.ClearSelection; 126 | src^.listview.Selected[nodo] := True; 127 | end; 128 | break; 129 | end; 130 | end else 131 | if ares_frmmain.tabs_pageview.activepage=IDTAB_LIBRARY then begin 132 | punto1 := ares_FrmMain.listview_lib.screentoclient(punto); 133 | nodo := ares_FrmMain.listview_lib.GetNodeAt(punto1.x,punto1.y); 134 | if nodo<>nil then begin 135 | setwindowpos(ares_FrmMain.handle,HWND_NOTOPMOST,0,0,0,0,SWP_NOMOVE or SWP_NOSIZE or SWP_NOOWNERZORDER); 136 | ares_FrmMain.listview_lib.ClearSelection; 137 | ares_FrmMain.listview_lib.Selected[nodo] := True; 138 | 139 | end; 140 | end else 141 | if ares_frmmain.tabs_pageview.activepage=IDTAB_TRANSFER then begin 142 | punto1 := ares_FrmMain.treeview_download.screentoclient(punto); 143 | nodo := ares_FrmMain.treeview_download.GetNodeAt(punto1.x,punto1.y); 144 | if nodo<>nil then begin 145 | setwindowpos(ares_FrmMain.handle,HWND_NOTOPMOST,0,0,0,0,SWP_NOMOVE or SWP_NOSIZE or SWP_NOOWNERZORDER); 146 | ares_FrmMain.treeview_download.ClearSelection; 147 | ares_FrmMain.treeview_download.Selected[nodo] := True; 148 | end else begin 149 | punto1 := ares_FrmMain.treeview_upload.screentoclient(punto); 150 | nodo := ares_FrmMain.treeview_upload.GetNodeAt(punto1.x,punto1.y); 151 | if Nodo<>nil then begin 152 | setwindowpos(ares_FrmMain.handle,HWND_NOTOPMOST,0,0,0,0,SWP_NOMOVE or SWP_NOSIZE or SWP_NOOWNERZORDER); 153 | ares_FrmMain.treeview_upload.ClearSelection; 154 | ares_FrmMain.treeview_upload.Selected[nodo] := True; 155 | end else begin 156 | punto1 := ares_FrmMain.treeview_queue.screentoclient(punto); 157 | nodo := ares_FrmMain.treeview_queue.GetNodeAt(punto1.x,punto1.y); 158 | if Nodo<>nil then begin 159 | setwindowpos(ares_FrmMain.handle,HWND_NOTOPMOST,0,0,0,0,SWP_NOMOVE or SWP_NOSIZE or SWP_NOOWNERZORDER); 160 | ares_FrmMain.treeview_queue.ClearSelection; 161 | ares_FrmMain.treeview_queue.Selected[nodo] := True; 162 | end; 163 | 164 | end; 165 | end; 166 | end; 167 | except 168 | end; 169 | formhint_hide; 170 | end; 171 | 172 | procedure Tfrmhint.FormResize(Sender: TObject); 173 | begin 174 | GraphWidth := self.width-12; 175 | BitMapGraph.width := self.width-2; 176 | BitMapGraph.height := 44; 177 | end; 178 | 179 | procedure Tfrmhint.FormDestroy(Sender: TObject); 180 | begin 181 | bitMapGraph.Free; 182 | end; 183 | 184 | end. 185 | -------------------------------------------------------------------------------- /ufrmpreview.dfm: -------------------------------------------------------------------------------- 1 | object frmpreview: Tfrmpreview 2 | Left = 486 3 | Top = 177 4 | BorderIcons = [biSystemMenu] 5 | BorderStyle = bsToolWindow 6 | ClientHeight = 91 7 | ClientWidth = 230 8 | Color = clBtnFace 9 | ParentFont = True 10 | OldCreateOrder = False 11 | Position = poOwnerFormCenter 12 | Scaled = False 13 | OnCreate = FormCreate 14 | OnResize = TntFormResize 15 | OnShow = TntFormShow 16 | PixelsPerInch = 96 17 | TextHeight = 13 18 | object Label1: TLabel 19 | Left = 4 20 | Top = 4 21 | Width = 225 22 | Height = 13 23 | AutoSize = False 24 | Font.Charset = DEFAULT_CHARSET 25 | Font.Color = clWindowText 26 | Font.Height = -11 27 | Font.Name = 'Tahoma' 28 | Font.Style = [] 29 | ParentFont = False 30 | end 31 | object Label2: TLabel 32 | Left = 4 33 | Top = 24 34 | Width = 3 35 | Height = 13 36 | end 37 | object ProgressBar1: TProgressBar 38 | Left = 4 39 | Top = 44 40 | Width = 221 41 | Height = 13 42 | TabOrder = 0 43 | end 44 | object btn_open: TTntButton 45 | Left = 120 46 | Top = 64 47 | Width = 81 48 | Height = 21 49 | TabOrder = 1 50 | OnClick = btn_openClick 51 | end 52 | object btn_cancel: TTntButton 53 | Left = 28 54 | Top = 64 55 | Width = 81 56 | Height = 21 57 | TabOrder = 2 58 | end 59 | end 60 | -------------------------------------------------------------------------------- /ufrmpreview.pas: -------------------------------------------------------------------------------- 1 | { 2 | this file is part of Ares 3 | Aresgalaxy ( http://aresgalaxy.sourceforge.net ) 4 | 5 | This program is free software; you can redistribute it and/or 6 | modify it under the terms of the GNU General Public License 7 | as published by the Free Software Foundation; either 8 | version 2 of the License, or (at your option) any later version. 9 | 10 | This program is distributed in the hope that it will be useful, 11 | but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | GNU General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program; if not, write to the Free Software 17 | Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 18 | } 19 | 20 | { 21 | Description: 22 | shows status of the AVI rebuild and/or file preview copy progress 23 | } 24 | 25 | unit ufrmpreview; 26 | 27 | interface 28 | 29 | uses 30 | Windows, {Messages,} SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 31 | StdCtrls, ComCtrls,const_ares, TntStdCtrls,tntforms,helper_unicode,vars_localiz; 32 | 33 | type 34 | Tfrmpreview = class(TTntForm) 35 | Label1: TLabel; 36 | Label2: TLabel; 37 | ProgressBar1: TProgressBar; 38 | btn_open: TTntButton; 39 | btn_cancel: TTntButton; 40 | procedure btn_cancelClick(Sender: TObject); 41 | procedure FormCreate(Sender: TObject); 42 | procedure btn_openClick(Sender: TObject); 43 | procedure TntFormShow(Sender: TObject); 44 | procedure TntFormResize(Sender: TObject); 45 | private 46 | fcancella: Boolean; 47 | fokstop: Boolean; 48 | public 49 | property cancella:boolean read fcancella write fcancella; 50 | property okstop:boolean read fokstop write fokstop; 51 | end; 52 | 53 | var 54 | frmpreview: Tfrmpreview; 55 | 56 | implementation 57 | 58 | uses utility_ares, ufrmmain; 59 | {$R *.DFM} 60 | 61 | procedure Tfrmpreview.btn_cancelClick(Sender: TObject); 62 | begin 63 | visible := False; 64 | cancella := True; 65 | end; 66 | 67 | procedure Tfrmpreview.FormCreate(Sender: TObject); 68 | begin 69 | cancella := False; 70 | okstop := False; 71 | btn_cancel.onclick := btn_cancelClick; 72 | btn_open.onclick := btn_openClick; 73 | try 74 | formstyle := fsStayOnTop; 75 | except 76 | end; 77 | end; 78 | 79 | procedure Tfrmpreview.btn_openClick(Sender: TObject); 80 | begin 81 | okstop := True; 82 | end; 83 | 84 | procedure Tfrmpreview.TntFormShow(Sender: TObject); 85 | begin 86 | font := ares_FrmMain.font; 87 | btn_cancel.caption := GetLangStringW(STR_CANCEL); 88 | btn_open.caption := GetLangStringW(STR_OKOPENIT); 89 | caption := GetLangStringW(STR_COPYINGFILE); 90 | end; 91 | 92 | procedure Tfrmpreview.TntFormResize(Sender: TObject); 93 | begin 94 | btn_cancel.left := (clientwidth div 2)-87; 95 | btn_open.left := (clientwidth div 2)+5; 96 | ProgressBar1.Width := clientwidth-8; 97 | end; 98 | 99 | end. 100 | -------------------------------------------------------------------------------- /umediar.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CWBudde/AresGalaxy/b6136fd50c80f73be3115b315bb15bbbf9d1b528/umediar.pas -------------------------------------------------------------------------------- /uplaylistfrm.dfm: -------------------------------------------------------------------------------- 1 | object PlaylistForm: TPlaylistForm 2 | Left = 207 3 | Top = 109 4 | BorderIcons = [] 5 | BorderStyle = bsNone 6 | ClientHeight = 323 7 | ClientWidth = 413 8 | Color = clBtnFace 9 | Font.Charset = DEFAULT_CHARSET 10 | Font.Color = clWindowText 11 | Font.Height = -11 12 | Font.Name = 'MS Sans Serif' 13 | Font.Style = [] 14 | OldCreateOrder = False 15 | OnShow = FormShow 16 | PixelsPerInch = 96 17 | TextHeight = 13 18 | end 19 | -------------------------------------------------------------------------------- /uplaylistfrm.pas: -------------------------------------------------------------------------------- 1 | { 2 | this file is part of Ares 3 | Aresgalaxy ( http://aresgalaxy.sourceforge.net ) 4 | 5 | This program is free software; you can redistribute it and/or 6 | modify it under the terms of the GNU General Public License 7 | as published by the Free Software Foundation; either 8 | version 2 of the License, or (at your option) any later version. 9 | 10 | This program is distributed in the hope that it will be useful, 11 | but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | GNU General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with this program; if not, write to the Free Software 17 | Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 18 | } 19 | 20 | unit uplaylistfrm; 21 | 22 | interface 23 | 24 | uses 25 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 26 | Dialogs,ares_types; 27 | 28 | type 29 | TPlaylistForm = class(TForm) 30 | procedure FormShow(Sender: TObject); 31 | protected 32 | procedure CreateParams(var Params: TCreateParams); override; 33 | private 34 | procedure DropFile(var message: ares_types.TWMDropFiles); message WM_DROPFILES; 35 | public 36 | { Public declarations } 37 | end; 38 | 39 | var 40 | PlaylistForm: TPlaylistForm; 41 | 42 | implementation 43 | 44 | {$R *.dfm} 45 | 46 | uses 47 | ufrmmain,drag_n_drop; 48 | 49 | procedure TPlaylistForm.CreateParams(var Params: TCreateParams); 50 | begin 51 | inherited CreateParams(Params); 52 | Params.ExStyle := Params.ExStyle or WS_EX_ACCEPTFILES; 53 | end; 54 | 55 | procedure TPlaylistForm.DropFile(var message: ares_types.TWMDropFiles); 56 | var 57 | i : integer; 58 | Begin 59 | for i := 0 to DropFileCount(message)-1 do 60 | if not ufrmmain.Drag_And_Drop_AddFile(DropGetFile(message,i),i) then exit; 61 | 62 | Dropped(message); // Very important 63 | end; 64 | 65 | procedure TPlaylistForm.FormShow(Sender: TObject); 66 | begin 67 | //DraGAcceptFiles(handle,true); 68 | end; 69 | 70 | end. 71 | --------------------------------------------------------------------------------