Jump to content

Celtic88

Active Members
  • Posts

    188
  • Joined

  • Last visited

2 Followers

About Celtic88

  • Birthday 02/13/1995

Profile Information

  • Location
    ALGERIA

Recent Profile Visitors

724 profile views

Celtic88's Achievements

Prodigy

Prodigy (4/7)

21

Reputation

  1. assembly source code x32 and x64 update 21/02/2021 ;by celtic88 use32 include 'c:\fasm\INCLUDE\win32ax.inc' startcode: mov ax, cs cmp al, $33 ;$23 ; WoW64 je __apithread_64 macro strucx lab, dty {struct lab WaitForSingleObject dty ? SendMessage dty ? GetLastError dty ? henvent dty ? hwnd dty ? pproc dty ? isprocessing dty ? returnlow dty ? returnhigh dty ? LastError dty ? exitthread dty ? ;!parm dty 100 dup (?) ends} strucx apithreadInfo,dd use32 __apithread: MOV edi, [esp+4] .l_startthread: push -1 push [edi + apithreadInfo.henvent] call [edi + apithreadInfo.WaitForSingleObject] test eax, eax jz @f inc [edi + apithreadInfo.exitthread] @@: mov ebx, [edi + apithreadInfo.exitthread] test ebx, ebx jnz .l_exitthread lea esi, [edi + sizeof.apithreadInfo] mov ecx, dword [esi] test ecx, ecx jz .l_noparm @@: push dword [esi+ecx*4] loop @b .l_noparm:call [edi + apithreadInfo.pproc] .l_exitthread: MOV [edi + apithreadInfo.returnlow], eax MOV [edi + apithreadInfo.returnhigh], edx call [edi + apithreadInfo.GetLastError] MOV [edi + apithreadInfo.LastError], eax xor eax, eax MOV [edi + apithreadInfo.isprocessing], eax push ebx push edi push eax push [edi + apithreadInfo.hwnd] call [edi + apithreadInfo.SendMessage] test ebx, ebx jz .l_startthread ret ;///////////////////////////////////////////////////////////////////////////////////// x 64 strucx apithreadInfo64,dq align 2 __apithread_64: use64 sub rsp,32+(8*100)+8 ;!or rsp,8 mov rbx, rcx .l_startthread: xor rdx, rdx dec rdx mov rcx, [rbx + apithreadInfo64.henvent] call [rbx + apithreadInfo64.WaitForSingleObject] test rax, rax jz @f inc [rbx + apithreadInfo64.exitthread] @@: mov r15, [rbx + apithreadInfo64.exitthread] test r15, r15 jnz .l_exitthread lea rsi, [rbx + sizeof.apithreadInfo64] LODSq test rax, rax jz .l_noparm mov r14, rax xor rcx, rcx add rcx, 4 @@:LODSq push rax loop @b sub r14, 4 cmp r14, rcx jle .l_skip mov rcx, r14 lea rdi, [rsp+8*4+32] ; push rax *4 @@:LODSq stosq loop @b .l_skip: pop r9 r8 rdx rcx .l_noparm:call [rbx + apithreadInfo64.pproc] .l_exitthread: MOV [rbx + apithreadInfo64.returnlow], rax MOV [rbx + apithreadInfo64.returnhigh], rdx call [rbx + apithreadInfo64.GetLastError] MOV [rbx + apithreadInfo64.LastError], rax xor rdx, rdx mov [rbx + apithreadInfo64.isprocessing],rdx mov r9, r15 mov r8, rbx mov rcx, [rbx + apithreadInfo64.hwnd] call [rbx + apithreadInfo64.SendMessage] test r15, r15 jz .l_startthread add rsp,32+(8*100)+8 ret
  2. hello ! just for fun simple code to call dll api in new thread ... *update 21/02/2021 -add callback for return api call -add x64 ;by celtic 88 #include <Memory.au3> #include <WinAPISys.au3> #include <WinAPIProc.au3> #include <GUIConstantsEx.au3> #include <WindowsConstants.au3> #include <WinAPIEx.au3> #include <WindowsConstants.au3> #include <WinAPIMem.au3> Global $thread_Class = 'thread_Class1' Local $hProc = DllCallbackRegister('thread_WM', 'lresult', 'hwnd;uint;wparam;lparam') Local $tClass = DllStructCreate('wchar[' & StringLen($thread_Class) + 1 & ']') DllStructSetData($tClass, 1, $thread_Class) Local $tWCEX = DllStructCreate($tagWNDCLASSEX) DllStructSetData($tWCEX, 'Size', DllStructGetSize($tWCEX)) DllStructSetData($tWCEX, 'hWndProc', DllCallbackGetPtr($hProc)) DllStructSetData($tWCEX, 'ClassName', DllStructGetPtr($tClass)) _WinAPI_RegisterClassEx($tWCEX) Global $opcode_struct = 'ptr WaitForSingleObject;' & _ 'ptr SendMessage;' & _ 'ptr GetLastError;' & _ 'ptr henvent;' & _ 'ptr hwnd;' & _ 'ptr pproc;' & _ 'ptr isprocessing;' & _ 'ptr lreturn;ptr hreturn;' & _ 'ptr LastError;' & _ 'ptr exitthread;' & _ 'ptr parm[100];ptr rsv[20];WCHAR callback[100]' Local $opcode = '0x668CC83C337449' & _ '8B7C24046AFFFF770CFF1785C07403FF47288B5F2885DB75118D772C8B0E85C97405FF348EE2FBFF571489471C895720FF570889472431C0894718535750FF7710FF570485DB74BCC3' & _ '4881EC480300004889CB4831D248FFCA488B4B18FF134885C0740448FF43504C8B7B504D85FF753A488D735848AD4885C0742C4989C64831C94883C10448AD50E2FB4983EE04493' & _ '9CE7E0E4C89F1488D7C244048AD48ABE2FA415941585A59FF53284889433848895340FF5310488943484831D2488953304D89F94989D8488B4B20FF53084D85FF74804881C448030000C3' Global $pshll = _MemVirtualAlloc(0, BinaryLen($opcode), $MEM_COMMIT, $PAGE_EXECUTE_READWRITE) DllStructSetData(DllStructCreate('byte[' & BinaryLen($opcode) & ']', $pshll), 1, $opcode) Func thread_WM($hWnd, $iMsg, $wParam, $lParam) ;window call back If $iMsg = $WM_NULL Then Local $thi = DllStructCreate($opcode_struct, $wParam) If $lParam <> 0 Then DllStructSetData($thi, 'rsv', -2, 4) DllStructSetData($thi, 'rsv', DllStructGetData($thi, 'rsv', 4) + 1, 4) Call(DllStructGetData($thi, 'callback'), $thi, DllStructGetData($thi, 'rsv', 4)) If $lParam <> 0 Then _WinAPI_DestroyWindow($hWnd) _WinAPI_CloseHandle(DllStructGetData($thi, 'henvent')) _MemGlobalFree($wParam) EndIf EndIf Return _WinAPI_DefWindowProc($hWnd, $iMsg, $wParam, $lParam) EndFunc ;==>thread_WM Func thread_create($scallback) ; create new remote api thread Local $thi = DllStructCreate($opcode_struct, _MemGlobalAlloc(DllStructGetSize(DllStructCreate($opcode_struct)), $GPTR)) DllStructSetData($thi, 'WaitForSingleObject', _WinAPI_GetProcAddress(_WinAPI_LoadLibrary('kernel32'), 'WaitForSingleObject')) DllStructSetData($thi, 'SendMessage', _WinAPI_GetProcAddress(_WinAPI_LoadLibrary('user32'), 'SendMessageW')) DllStructSetData($thi, 'GetLastError', _WinAPI_GetProcAddress(_WinAPI_LoadLibrary('kernel32'), 'GetLastError')) DllStructSetData($thi, 'henvent', _WinAPI_CreateEvent(0, 0, 0, 0)) ; DllStructSetData($thi, 'hwnd', _WinAPI_CreateWindowEx(0, $thread_Class, '', 0, 0, 0, 0, 0, 0)) Local $thid = DllCall('kernel32', 'hwnd', 'CreateThread', 'ptr', 0, 'dword', 0, 'ptr', _ $pshll, 'ptr', DllStructGetPtr($thi), 'long', 0, 'int*', 0) DllStructSetData($thi, 'rsv', $thid[0], 2) DllStructSetData($thi, 'rsv', $thid[6], 3) DllStructSetData($thi, 'callback', $scallback) Call(DllStructGetData($thi, 'callback'), $thi, DllStructGetData($thi, 'rsv', 4)) Return $thi EndFunc ;==>thread_create Func thread_close($thi) ; close remote api thread DllStructSetData($thi, 'exitthread', 1) _WinAPI_SetEvent(DllStructGetData($thi, 'henvent')) EndFunc ;==>thread_close Func thread_isrunning($thi) ; check if remote api thread is closed or no Return (DllStructGetData($thi, 'exitthread') = 0) EndFunc ;==>thread_isrunning Func thread_GetLastError($thi) ; Get Last Error in remote thread Return DllStructGetData($thi, 'LastError') EndFunc ;==>thread_GetLastError Func thread_getreturn($thi) ; get api call return Return DllStructGetData($thi, 'lreturn') EndFunc ;==>thread_getreturn Func thread_call($thi, $pproc) ; dllcall $pproc = address of api DllStructSetData($thi, 'pproc', $pproc) DllStructSetData($thi, 'isprocessing', 1) _WinAPI_SetEvent(DllStructGetData($thi, 'henvent')) DllStructSetData($thi, 'rsv', 0, 1) EndFunc ;==>thread_call Func thread_addcallparameters($thi, $val) ; add dllcall parameters Local $idx = DllStructGetData($thi, 'rsv', 1) + 1 DllStructSetData($thi, 'rsv', $idx, 1) DllStructSetData($thi, 'parm', $idx, 1) DllStructSetData($thi, 'parm', $val, $idx + 1) EndFunc ;==>thread_addcallparameters Func thread_callsimple($thi, $dll, $nproc, $p1 = Default, $p2 = Default, $p3 = Default, _ $p4 = Default, $p5 = Default, $p6 = Default, $p7 = Default, $p8 = Default, _ $p9 = Default, $p10 = Default, $p11 = Default, $p12 = Default, $p13 = Default, _ $p14 = Default, $p15 = Default, $p16 = Default, $p17 = Default, $p18 = Default) ; simple call api ;) Local $cp = 1 While Execute('$p' & $cp & ' <> Default') thread_addcallparameters($thi, Execute('$p' & $cp)) $cp += 1 WEnd thread_call($thi, _WinAPI_GetProcAddress(_WinAPI_LoadLibrary($dll), $nproc)) EndFunc ;==>thread_callsimple Opt("MustDeclareVars", 1) Global $s1, $s2 Func __thread_callback($thi, $phase) Switch $phase Case -1 ;thread is closed MsgBox(0, '', 'thread is closed return ' & thread_getreturn($thi) & ' error ' & thread_GetLastError($thi)) Case 0 ;thread is started $s1 = _WinAPI_CreateString('i love autoit') $s2 = _WinAPI_CreateString('from remote thread') thread_callsimple($thi, 'user32', 'MessageBoxW', 0, $s1, $s2, 0x00000006) ;~ ;DllCall('user32', 'int', 'MessageBoxW', 'hwnd', 0, 'ptr', $s1, 'ptr', $s2, 'uint', 0x00000006) Case 1 ;return first call _WinAPI_FreeMemory($s1) _WinAPI_FreeMemory($s2) MsgBox(0, '', 'callback api return ' & thread_getreturn($thi) & ' error ' & thread_GetLastError($thi)) $s2 = DllStructCreate('dword') DllStructSetData($s2, 1, 1024) $s1 = DllStructCreate('wchar[1024]') thread_callsimple($thi, 'Advapi32', 'GetUserNameW', DllStructGetPtr($s1), DllStructGetPtr($s2)) ;~ ;DllCall('Advapi32', 'BOOL', 'GetUserNameW', 'ptr', DllStructGetPtr($s1), 'ptr', DllStructGetPtr($s2)) Case 2 ;return second call MsgBox(0, '', 'callback api return : ' & thread_getreturn($thi) & _ @CRLF & ' error : ' & thread_GetLastError($thi) & _ @CRLF & ' string len : ' & DllStructGetData($s2, 1) & _ @CRLF & ' user name : ' & DllStructGetData($s1, 1) & _ '') thread_close($thi) ;endif thread Case 3 ; return previous call EndSwitch EndFunc ;==>__thread_callback Local $rth = thread_create('__thread_callback') While thread_isrunning($rth) ConsoleWrite('thread is running' & @CRLF) Sleep(1000) WEnd
  3. why my code does not work :/ #include "WinHttp.au3" #include "JSON.au3" Opt("MustDeclareVars", 1) Global $hOpen = _WinHttpOpen() Global $hConnect = _WinHttpConnect($hOpen, "https://api.coinpaprika.com/", $INTERNET_DEFAULT_HTTPS_PORT) Global $hRequest = _WinHttpOpenRequest($hConnect, _ "GET", _ "v1/coins/btc-bitcoin") _WinHttpSendRequest($hRequest) _WinHttpReceiveResponse($hRequest) Local $sReturned = '' If _WinHttpQueryDataAvailable($hRequest) Then Do $sReturned &= _WinHttpReadData($hRequest) Until @error EndIf MsgBox(0, 0, $sReturned)
  4. your dll is "cdecl" x86 calling conventions, stack is corrupted if you use stdcall, use int:cdecl DllCall("UniversalSpeech.dll", "int:cdecl", "speechSay", "wstr", $s_text, "int", $interrupt)
  5. Hi all, The code allows to checks if an event happened on one of the tcp connection , call return : event : $TCPEvent_Disconnect = Connection is dead $TCPEvent_None = Noting.. $TCPEvent_Data = data arrived #by celtic88 Global Const $TCPEvent_Disconnect = -1 ;Connection is dead Global Const $TCPEvent_None = 0 ;Noting.. Global Const $TCPEvent_Data = 1 ;data available Func TCPSocketEvent($hSocket) Local $timeval = DllStructCreate("int tv_sec;int tv_usec") Local $fd_set = DllStructCreate("int fd_count;UINT fd_array[64]") Local $ValLong = DllStructCreate("long length") DllStructSetData($fd_set, "fd_count", 1) DllStructSetData($fd_set, "fd_array", $hSocket, 1) Local $result = DllCall("Ws2_32.dll", "int", "select", "int", $hSocket + 1, "struct*", $fd_set, "ptr", 0, "ptr", 0, "struct*", $timeval) If @error Then Return $TCPEvent_Disconnect If $result[0] < 0 Then Return $TCPEvent_Disconnect ; Seems to be an error Local $result2 = DllCall("Ws2_32.dll", "int", "__WSAFDIsSet", "UINT", $hSocket, "struct*", $fd_set) If @error Then Return $TCPEvent_Disconnect If $result[0] = 0 Or $result2[0] = 0 Then Return $TCPEvent_None ; No data available Local $FIONREAD = 0x4004667F Local $aRet = DllCall("Ws2_32.dll", "int", "ioctlsocket", "uint", $hSocket, "long", $FIONREAD, "struct*", $ValLong) If @error Then Return $TCPEvent_Disconnect If $aRet[0] <> 0 Then Return $TCPEvent_Disconnect Local $length = DllStructGetData($ValLong, "length") If $length = 0 Then Return $TCPEvent_Disconnect ;~ Return $length Return $TCPEvent_Data EndFunc ;==>TCPSocketIsAlive exemple : Server : #include <TCPEvent.au3> Func Example() TCPStartup() Local $sIPAddress = "0.0.0.0" Local $iPort = 65432 Local $iListenSocket = TCPListen($sIPAddress, $iPort, 100) Local $iError = 0 If @error Then $iError = @error MsgBox(16, "Server", "Could not listen, Error code: " & $iError) Return False EndIf Local $iSocket = 0 Do $iSocket = TCPAccept($iListenSocket) If @error Then $iError = @error MsgBox(16, "Server", "Could not accept the incoming connection, Error code: " & $iError) Return False EndIf Until $iSocket <> -1 MsgBox(32, "Server", "Client Connected") Local $EvSock While 1 Sleep(100) $EvSock = TCPEvent($iSocket) Switch $EvSock Case $NetworkEvent_Disconnect MsgBox(32, "Server", "Connection closed") ExitLoop Case $NetworkEvent_Data MsgBox(32, "Server", "Reciev Data : " & TCPRecv($iSocket, 1000)) TCPSend($iSocket, "Test Ok") MsgBox(32, "Server", "Exit") ExitLoop EndSwitch WEnd TCPCloseSocket($iSocket) EndFunc ;==>Example Example() client #include <TCPEvent.au3> Func Exemple() TCPStartup() Local $sIPAddress = "127.0.0.1" Local $iPort = 65432 Local $iSocket = TCPConnect($sIPAddress, $iPort) If @error Then Local $iError = @error MsgBox(16, "Client", "Could not connect, Error code: " & $iError) Else MsgBox(32, "Client", "Connection successful") TCPSend($iSocket, "Test") Local $EvSock While 1 Sleep(100) $EvSock = TCPEvent($iSocket) Switch $EvSock Case $TCPEvent_Disconnect MsgBox(32, "Client", "Connection closed") ExitLoop Case $TCPEvent_Data MsgBox(32, "Client", "Reciev Data : " & TCPRecv($iSocket, 1000)) EndSwitch WEnd EndIf ; Close the socket. TCPCloseSocket($iSocket) EndFunc ;==>Exemple Exemple()
  6. hi SkythekidRS, welcom to Autoit forum, here link to help you : https://www.autoitscript.com/autoit3/docs/libfunctions/_GUICtrlTreeView_GetTree.htm
  7. Maybe that's what you are looking for? Local $sFileOpenDialog = FileOpenDialog("", @WorkingDir & "\", "Exe (*.exe)", 1) If @error Then Exit Local $hFileOpen = FileOpen($sFileOpenDialog, 16) If $hFileOpen = -1 Then MsgBox($MB_SYSTEMMODAL, "", "An error occurred when reading the file.") Exit EndIf Local $sFileRead = FileRead($hFileOpen) FileClose($hFileOpen) Local $File_struct = DllStructCreate("BYTE File[" & BinaryLen($sFileRead) & "]") DllStructSetData($File_struct, "File", $sFileRead) for $io = 0 to BinaryLen($sFileRead) msgbox(0,"","0x" & hex(DllStructGetData($File_struct, "File",$io),2)) next
  8. Hi guys, I have translated a Delphi code "GEOIP API" To Autoit ,but my code not working ? someone can tell me why and thank you my code: Local $sFileOpenDialog = FileOpenDialog("Select a Geoip data", @WorkingDir & "\", "Geoip (*.Dat)", 1) If @error Then Exit Local $hFileOpen = FileOpen($sFileOpenDialog, 16) If $hFileOpen = -1 Then MsgBox($MB_SYSTEMMODAL, "", "An error occurred when reading the file.") Exit EndIf Local $sFileRead = FileRead($hFileOpen) FileClose($hFileOpen) Local $Geoip_struct = DllStructCreate("BYTE Geoip[" & BinaryLen($sFileRead) & "]") DllStructSetData($Geoip_struct, "Geoip", $sFileRead) Global $Geomempos = DllStructGetPtr($Geoip_struct, "Geoip") Global $FDatabaseSegments[1] = [16776960] Global $CountryNames _GetCountryNames($CountryNames) $ipNum = _IPv4ToInt("195.154.91.148") MsgBox(0, "", SeekRecord($ipNum)) Func SeekRecord($ipn) Dim $x[2] Local $offset = 0 Local $FRecordLength = 3 Local $Buff Local $depth, $i, $j, $y For $depth = 31 To 0 Step -1 $Buff = DllStructCreate("BYTE Buff[6]", $Geomempos + ((2 * $FRecordLength) * $offset)) For $i = 0 To 1 $x[$i] = 0 For $j = 0 To $FRecordLength - 1 $y = DllStructGetData($Buff, "Buff", $i * $FRecordLength + $j) $x[$i] += ShiftLeft($y, $j * 8) Next Next If BitAND($ipn, ShiftLeft(1, $depth)) > 0 Then If $x[1] >= $FDatabaseSegments[0] Then Return $x[1] Else $offset = $x[1] EndIf Else If $x[0] >= $FDatabaseSegments[0] Then Return $x[0] Else $offset = $x[0] EndIf EndIf Next Return 0 EndFunc ;==>SeekRecord Func ShiftLeft($Vall, $Count) For $o = 1 To $Count $Vall = $Vall * 2 Next Return $Vall EndFunc ;==>ShiftLeft Func _IPv4ToInt($sString) ; By JohnOne Local $aStringSplit = StringSplit($sString, '.', 3) Local $iOct1 = Int($aStringSplit[0]) * (256 ^ 3) Local $iOct2 = Int($aStringSplit[1]) * (256 ^ 2) Local $iOct3 = Int($aStringSplit[2]) * (256) Local $iOct4 = Int($aStringSplit[3]) Return $iOct1 + $iOct2 + $iOct3 + $iOct4 EndFunc ;==>_IPv4ToIntdelphi code { * Copyright (C) 2005 MaxMind LLC All Rights Reserved. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public * License as published by the Free Software Foundation; either * version 2 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * General Public License for more details. * * You should have received a copy of the GNU General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA * ChangeLog * 2003-04-09 Translation of C# class to Pascal provided by W. Tracz * 2005-07-20 Added support for GeoIP Region, City, ISP and Organization (Yvan Schwab/esoftys) } { Thanks to W. Tracz/Yvan Schwab for contributing this class } unit GeoIP; interface uses Classes, SysUtils, WinSock; type TGeoIPResult = ( GEOIP_SUCCESS = 0, GEOIP_NODATA = 1, GEOIP_ERROR_IPADDR = 2, GEOIP_ERROR_DBTYPE = 3, GEOIP_ERROR_IO = 4 ); TGeoIPDBTypes = ( GEOIP_COUNTRY_EDITION = 1, GEOIP_REGION_EDITION_REV0 = 7, GEOIP_CITY_EDITION_REV0 = 6, GEOIP_ORG_EDITION = 5, GEOIP_ISP_EDITION = 4, GEOIP_CITY_EDITION_REV1 = 2, GEOIP_REGION_EDITION_REV1 = 3, GEOIP_PROXY_EDITION = 8, GEOIP_ASNUM_EDITION = 9 ); TGeoIPCountry = record CountryCode: string; CountryName: string; end; TGeoIPRegion = record CountryCode: string; Region: string; end; TGeoIPCity = record CountryCode: string; CountryName: string; Region: string; City: string; PostalCode: string; Latitude: Double; Longitude: Double; DmaCode: Integer; AreaCode: Integer; end; TGeoIPOrg = record Name: string; end; TGeoIP = class private FInputFile: TFileStream; FDatabaseType: TGeoIPDBTypes; FDatabaseSegments: array of Cardinal; FDatabaseInfo: string; FRecordLength: Cardinal; function _GetCity(IPNum: Cardinal; var GeoIPCity: TGeoIPCity): TGeoIPResult; function _GetCountry(IPNum: Cardinal; var GeoIPCountry: TGeoIPCountry): TGeoIPResult; function _GetOrg(IPNum: Cardinal; var GeoIPOrg: TGeoIPOrg): TGeoIPResult; function _GetRegion(IPNum: Cardinal; var GeoIPRegion: TGeoIPRegion): TGeoIPResult; function AddrToNum(const IPAddr: string): Cardinal; procedure InitDBFile; function SeekRecord(IPNum: Cardinal): Cardinal; public constructor Create(const FileName: string); destructor Destroy; override; function GetCity(const IPAddr: string; var GeoIPCity: TGeoIPCity): TGeoIPResult; function GetCountry(const IPAddr: string; var GeoIPCountry: TGeoIPCountry): TGeoIPResult; function GetDatabaseInfo: string; function GetOrg(const IPAddr: string; var GeoIPOrg: TGeoIPOrg): TGeoIPResult; function GetRegion(const IPAddr: string; var GeoIPRegion: TGeoIPRegion): TGeoIPResult; end; const CountryCodes:array [0..252] of string = ('--','AP','EU','AD','AE','AF','AG','AI','AL','AM','AN','AO','AQ','AR','AS','AT','AU','AW','AZ','BA','BB','BD','BE','BF','BG','BH','BI','BJ','BM','BN','BO','BR','BS','BT','BV','BW','BY','BZ','CA','CC','CD','CF','CG','CH','CI','CK','CL','CM','CN','CO','CR','CU','CV','CX','CY','CZ','DE','DJ','DK','DM','DO','DZ','EC','EE','EG','EH','ER','ES','ET','FI','FJ','FK','FM','FO','FR','FX','GA','GB','GD','GE','GF','GH','GI','GL','GM','GN','GP','GQ','GR','GS','GT','GU','GW', 'GY','HK','HM','HN','HR','HT','HU','ID','IE','IL','IN','IO','IQ','IR','IS','IT','JM','JO','JP','KE','KG','KH','KI','KM','KN','KP','KR','KW','KY','KZ','LA','LB','LC','LI','LK','LR','LS','LT','LU','LV','LY','MA','MC','MD','MG','MH','MK','ML','MM','MN','MO','MP','MQ','MR','MS','MT','MU','MV','MW','MX','MY','MZ','NA','NC','NE','NF','NG','NI','NL','NO','NP','NR','NU','NZ','OM','PA','PE','PF','PG','PH','PK','PL','PM','PN','PR','PS','PT','PW','PY','QA','RE','RO','RU', 'RW','SA','SB','SC','SD','SE','SG','SH','SI','SJ','SK','SL','SM','SN','SO','SR','ST','SV','SY','SZ','TC','TD','TF','TG','TH','TJ','TK','TM','TN','TO','TL','TR','TT','TV','TW','TZ','UA','UG','UM','US','UY','UZ','VA','VC','VE','VG','VI','VN','VU','WF','WS','YE','YT','RS','ZA','ZM','ME','ZW','A1','A2','O1','AX','GG','IM','JE','BL','MF'); CountryNames:array [0..252] of string = ('N/A','Asia/Pacific Region','Europe','Andorra','United Arab Emirates','Afghanistan','Antigua and Barbuda','Anguilla','Albania','Armenia','Netherlands Antilles','Angola','Antarctica','Argentina','American Samoa','Austria','Australia','Aruba','Azerbaijan','Bosnia and Herzegovina','Barbados','Bangladesh','Belgium','Burkina Faso','Bulgaria','Bahrain','Burundi','Benin','Bermuda','Brunei Darussalam','Bolivia','Brazil','Bahamas','Bhutan','Bouvet Island','Botswana', 'Belarus','Belize','Canada','Cocos (Keeling) Islands','Congo, The Democratic Republic of the','Central African Republic','Congo','Switzerland','Cote D''Ivoire','Cook Islands','Chile','Cameroon','China','Colombia','Costa Rica','Cuba','Cape Verde','Christmas Island','Cyprus','Czech Republic','Germany','Djibouti','Denmark','Dominica','Dominican Republic','Algeria','Ecuador','Estonia','Egypt','Western Sahara','Eritrea','Spain','Ethiopia','Finland','Fiji', 'Falkland Islands (Malvinas)','Micronesia, Federated States of','Faroe Islands','France','France, Metropolitan','Gabon','United Kingdom','Grenada','Georgia','French Guiana','Ghana','Gibraltar','Greenland','Gambia','Guinea','Guadeloupe','Equatorial Guinea','Greece','South Georgia and the South Sandwich Islands','Guatemala','Guam','Guinea-Bissau','Guyana','Hong Kong','Heard Island and McDonald Islands','Honduras','Croatia','Haiti','Hungary','Indonesia','Ireland', 'Israel','India','British Indian Ocean Territory','Iraq','Iran, Islamic Republic of','Iceland','Italy','Jamaica','Jordan','Japan','Kenya','Kyrgyzstan','Cambodia','Kiribati','Comoros','Saint Kitts and Nevis','Korea, Democratic People''s Republic of','Korea, Republic of','Kuwait','Cayman Islands','Kazakstan','Lao People''s Democratic Republic','Lebanon','Saint Lucia','Liechtenstein','Sri Lanka','Liberia','Lesotho','Lithuania','Luxembourg','Latvia', 'Libyan Arab Jamahiriya','Morocco','Monaco','Moldova, Republic of','Madagascar','Marshall Islands','Macedonia, the Former Yugoslav Republic of','Mali','Myanmar','Mongolia','Macao','Northern Mariana Islands','Martinique','Mauritania','Montserrat','Malta','Mauritius','Maldives','Malawi','Mexico','Malaysia','Mozambique','Namibia','New Caledonia','Niger','Norfolk Island','Nigeria','Nicaragua','Netherlands','Norway','Nepal','Nauru','Niue','New Zealand','Oman', 'Panama','Peru','French Polynesia','Papua New Guinea','Philippines','Pakistan','Poland','Saint Pierre and Miquelon','Pitcairn','Puerto Rico','Palestinian Territory, Occupied','Portugal','Palau','Paraguay','Qatar','Reunion','Romania','Russian Federation','Rwanda','Saudi Arabia','Solomon Islands','Seychelles','Sudan','Sweden','Singapore','Saint Helena','Slovenia','Svalbard and Jan Mayen','Slovakia','Sierra Leone','San Marino','Senegal','Somalia','Suriname', 'Sao Tome and Principe','El Salvador','Syrian Arab Republic','Swaziland','Turks and Caicos Islands','Chad','French Southern Territories','Togo','Thailand','Tajikistan','Tokelau','Turkmenistan','Tunisia','Tonga','Timor-Leste','Turkey','Trinidad and Tobago','Tuvalu','Taiwan','Tanzania, United Republic of','Ukraine','Uganda','United States Minor Outlying Islands','United States','Uruguay','Uzbekistan','Holy See (Vatican City State)', 'Saint Vincent and the Grenadines','Venezuela','Virgin Islands, British','Virgin Islands, U.S.','Vietnam','Vanuatu','Wallis and Futuna','Samoa','Yemen','Mayotte','Serbia','South Africa','Zambia','Montenegro','Zimbabwe','Anonymous Proxy','Satellite Provider','Other','Aland Islands','Guernsey','Isle of Man','Jersey','Saint Barthelemy','Saint Martin'); implementation const COUNTRY_BEGIN = 16776960; STATE_BEGIN_REV0 = 16700000; STATE_BEGIN_REV1 = 16000000; STRUCTURE_INFO_MAX_SIZE = 20; DATABASE_INFO_MAX_SIZE = 100; SEGMENT_RECORD_LENGTH = 3; STANDARD_RECORD_LENGTH = 3; ORG_RECORD_LENGTH = 4; MAX_RECORD_LENGTH = 4; MAX_ORG_RECORD_LENGTH = 300; FULL_RECORD_LENGTH = 50; US_OFFSET = 1; CANADA_OFFSET = 677; WORLD_OFFSET = 1353; FIPS_RANGE = 360; { TGeoIP } constructor TGeoIP.Create(const FileName: string); begin inherited Create; FInputFile := TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone); InitDBFile; end; destructor TGeoIP.Destroy; begin if Assigned(FInputFile) then FInputFile.Free; inherited Destroy; end; function TGeoIP._GetCity(IPNum: Cardinal; var GeoIPCity: TGeoIPCity): TGeoIPResult; var SeekCity: Cardinal; RecordPointer: Cardinal; StrLen: Cardinal; buf: array[0..FULL_RECORD_LENGTH-1] of Byte; p: PChar; i: Integer; DmaAreaCombo: Integer; begin if (FDatabaseType <> GEOIP_CITY_EDITION_REV0) and (FDatabaseType <> GEOIP_CITY_EDITION_REV1) then begin Result := GEOIP_ERROR_DBTYPE; Exit; end; SeekCity := SeekRecord(IPNum); if SeekCity = FDatabaseSegments[0] then begin Result := GEOIP_NODATA; Exit; end; RecordPointer := SeekCity + (2 * FRecordLength - 1) * FDatabaseSegments[0]; FInputFile.Seek(RecordPointer, soFromBeginning); FInputFile.Read(buf, FULL_RECORD_LENGTH); // get country GeoIPCity.CountryCode := CountryCodes[buf[0]]; GeoIPCity.CountryName := CountryNames[buf[0]]; // get region p := @buf[1]; StrLen := 0; while (p[StrLen] <> #0) do Inc(StrLen); GeoIPCity.Region := Copy(p, 0, StrLen); // get city Inc(p, StrLen + 1); StrLen := 0; while (p[StrLen] <> #0) do Inc(StrLen); GeoIPCity.City := Copy(p, 0, StrLen); // get postal code Inc(p, StrLen + 1); StrLen := 0; while (p[StrLen] <> #0) do Inc(StrLen); GeoIPCity.PostalCode := Copy(p, 0, StrLen); // get latitude Inc(p, StrLen + 1); GeoIPCity.Latitude := 0.0; for i:=0 to 2 do begin GeoIPCity.Latitude := GeoIPCity.Latitude + (Integer(p[i]) shl (i*8)); end; GeoIPCity.Latitude := GeoIPCity.Latitude/10000 - 180; // get longitude Inc(p, 3); GeoIPCity.Longitude := 0.0; for i:=0 to 2 do begin GeoIPCity.Longitude := GeoIPCity.Longitude + (Integer(p[i]) shl (i*8)); end; GeoIPCity.Longitude := GeoIPCity.Longitude/10000 - 180; // get area code and dma code for post April 2002 databases and for US locations GeoIPCity.DmaCode := 0; GeoIPCity.AreaCode := 0; if FDatabaseType = GEOIP_CITY_EDITION_REV1 then begin if GeoIPCity.CountryCode = 'US' then begin Inc(p, 3); DmaAreaCombo := 0; for i:=0 to 2 do begin DmaAreaCombo := DmaAreaCombo + (Integer(p[i]) shl (i*8)); end; GeoIPCity.DmaCode := DmaAreaCombo div 1000; GeoIPCity.AreaCode := DmaAreaCombo mod 1000; end; end; Result := GEOIP_SUCCESS; end; function TGeoIP._GetCountry(IPNum: Cardinal; var GeoIPCountry: TGeoIPCountry): TGeoIPResult; var ret: Cardinal; begin if (FDatabaseType <> GEOIP_COUNTRY_EDITION) and (FDatabaseType <> GEOIP_PROXY_EDITION) then begin Result := GEOIP_ERROR_DBTYPE; Exit; end; ret := SeekRecord(IPNum) - COUNTRY_BEGIN; if ret > 0 then begin GeoIPCountry.CountryCode := CountryCodes[ret]; GeoIPCountry.CountryName := CountryNames[ret]; Result := GEOIP_SUCCESS; end else begin Result := GEOIP_NODATA; end; end; function TGeoIP._GetOrg(IPNum: Cardinal; var GeoIPOrg: TGeoIPOrg): TGeoIPResult; var SeekOrg: Cardinal; RecordPointer: Cardinal; StrLen: Cardinal; buf: array[0..MAX_ORG_RECORD_LENGTH-1] of Byte; p: PChar; begin if (FDatabaseType <> GEOIP_ORG_EDITION) and (FDatabaseType <> GEOIP_ISP_EDITION) and (FDatabaseType <> GEOIP_ASNUM_EDITION) then begin Result := GEOIP_ERROR_DBTYPE; Exit; end; SeekOrg := SeekRecord(IPNum); if SeekOrg = FDatabaseSegments[0] then begin Result := GEOIP_NODATA; Exit; end; RecordPointer := SeekOrg + (2 * FRecordLength - 1) * FDatabaseSegments[0]; FInputFile.Seek(RecordPointer, soFromBeginning); FInputFile.Read(buf, FULL_RECORD_LENGTH); p := @buf[0]; StrLen := 0; while (p[StrLen] <> #0) do Inc(StrLen); GeoIPOrg.Name := Copy(p, 0, StrLen); Result := GEOIP_SUCCESS; end; function TGeoIP._GetRegion(IPNum: Cardinal; var GeoIPRegion: TGeoIPRegion): TGeoIPResult; var SeekRegion: Cardinal; begin if (FDatabaseType <> GEOIP_REGION_EDITION_REV0) and (FDatabaseType <> GEOIP_REGION_EDITION_REV1) then begin Result := GEOIP_ERROR_DBTYPE; Exit; end; SeekRegion := SeekRecord(IPNum); if FDatabaseType = GEOIP_REGION_EDITION_REV0 then begin // Region Edition, pre June 2003 Dec(SeekRegion, STATE_BEGIN_REV0); if SeekRegion >= 1000 then begin GeoIPRegion.CountryCode := 'US'; GeoIPRegion.Region := Chr((SeekRegion - 1000) div 26 + 65) + Chr((SeekRegion - 1000) mod 26 + 65); end else begin GeoIPRegion.CountryCode := CountryCodes[SeekRegion]; GeoIPRegion.Region := ''; end; end else if FDatabaseType = GEOIP_REGION_EDITION_REV1 then begin // Region Edition, post June 2003 Dec(SeekRegion, STATE_BEGIN_REV1); if SeekRegion < US_OFFSET then begin // Unknown GeoIPRegion.CountryCode := ''; GeoIPRegion.Region := ''; end else if SeekRegion < CANADA_OFFSET then begin // USA State GeoIPRegion.CountryCode := 'US'; GeoIPRegion.Region := Chr((SeekRegion - US_OFFSET) div 26 + 65) + Chr((SeekRegion - US_OFFSET) mod 26 + 65); end else if SeekRegion < WORLD_OFFSET then begin // Canada Province GeoIPRegion.CountryCode := 'CA'; GeoIPRegion.Region := Chr((SeekRegion - CANADA_OFFSET) div 26 + 65) + Chr((SeekRegion - CANADA_OFFSET) mod 26 + 65); end else begin // Not US or Canada GeoIPRegion.CountryCode := CountryCodes[(SeekRegion - WORLD_OFFSET) div FIPS_RANGE]; GeoIPRegion.Region := ''; end; end; Result := GEOIP_SUCCESS; end; function TGeoIP.AddrToNum(const IPAddr: string): Cardinal; var netlong: LongInt; begin netlong := inet_addr(PChar(IPAddr)); if netlong <> INADDR_NONE then Result := ntohl(netlong) else Result := 0; end; function TGeoIP.GetCity(const IPAddr: string; var GeoIPCity: TGeoIPCity): TGeoIPResult; var IPNum: Cardinal; begin IPNum := AddrToNum(IPAddr); if IPNum = 0 then begin Result := GEOIP_ERROR_IPADDR; Exit; end; Result := _GetCity(IPNum, GeoIPCity); end; function TGeoIP.GetCountry(const IPAddr: string; var GeoIPCountry: TGeoIPCountry): TGeoIPResult; var IPNum: Cardinal; begin IPNum := AddrToNum(IPAddr); if IPNum = 0 then begin Result := GEOIP_ERROR_IPADDR; Exit; end; Result := _GetCountry(IPNum, GeoIPCountry); end; function TGeoIP.GetDatabaseInfo: string; var i: Integer; delim: array[0..2] of Byte; HasStructureInfo: Boolean; begin FDatabaseInfo := ''; HasStructureInfo := False; FInputFile.Seek(-3, soFromEnd); for i:=0 to STRUCTURE_INFO_MAX_SIZE-1 do begin FInputFile.Read(delim, 3); if (delim[0] = 255) and (delim[1] = 255) and (delim[2] = 255) then begin HasStructureInfo := True; Break; end; FInputFile.Seek(-4, soFromCurrent); end; if HasStructureInfo then FInputFile.Seek(-3, soFromCurrent) else // no structure info, must be pre Sep 2002 database, go back to end FInputFile.Seek(-3, soFromEnd); for i:=0 to DATABASE_INFO_MAX_SIZE-1 do begin FInputFile.Read(delim, 3); if (delim[0] = 0) and (delim[1] = 0) and (delim[2] = 0) then begin SetLength(FDatabaseInfo, i); FInputFile.Read(PChar(FDatabaseInfo)^, i); Break; end; FInputFile.Seek(-4, soFromCurrent); end; Result := FDatabaseInfo; end; function TGeoIP.GetOrg(const IPAddr: string; var GeoIPOrg: TGeoIPOrg): TGeoIPResult; var IPNum: Cardinal; begin IPNum := AddrToNum(IPAddr); if IPNum = 0 then begin Result := GEOIP_ERROR_IPADDR; Exit; end; Result := _GetOrg(IPNum, GeoIPOrg); end; function TGeoIP.GetRegion(const IPAddr: string; var GeoIPRegion: TGeoIPRegion): TGeoIPResult; var IPNum: Cardinal; begin IPNum := AddrToNum(IPAddr); if IPNum = 0 then begin Result := GEOIP_ERROR_IPADDR; Exit; end; Result := _GetRegion(IPNum, GeoIPRegion); end; procedure TGeoIP.InitDBFile; var i,j: Integer; delim: array[0..2] of Byte; buf: array[0..SEGMENT_RECORD_LENGTH-1] of Byte; begin // default to GeoIP Country Edition FDatabaseType := GEOIP_COUNTRY_EDITION; FRecordLength := STANDARD_RECORD_LENGTH; FInputFile.Seek(-3, soFromEnd); for i:=0 to STRUCTURE_INFO_MAX_SIZE-1 do begin FInputFile.Read(delim, 3); if (delim[0] = 255) and (delim[1] = 255) and (delim[2] = 255) then begin FInputFile.Read(FDatabaseType, 1); if Byte(FDatabaseType) >= 106 then begin // Backward compatibility with databases from April 2003 and earlier Dec(FDatabaseType, 105); end; if FDatabaseType = GEOIP_REGION_EDITION_REV0 then begin // Region Edition, pre June 2003 SetLength(FDatabaseSegments, 1); FDatabaseSegments[0] := STATE_BEGIN_REV0; end else if FDatabaseType = GEOIP_REGION_EDITION_REV1 then begin // Region Edition, post June 2003 SetLength(FDatabaseSegments, 1); FDatabaseSegments[0] := STATE_BEGIN_REV1; end else if (FDatabaseType = GEOIP_CITY_EDITION_REV0) or (FDatabaseType = GEOIP_CITY_EDITION_REV1) or (FDatabaseType = GEOIP_ORG_EDITION) or (FDatabaseType = GEOIP_ISP_EDITION) or (FDatabaseType = GEOIP_ASNUM_EDITION) then begin // City/Org Editions have two segments, read offset of second segment SetLength(FDatabaseSegments, 1); FDatabaseSegments[0] := 0; FInputFile.Read(buf, SEGMENT_RECORD_LENGTH); for j:=0 to SEGMENT_RECORD_LENGTH-1 do begin Inc(FDatabaseSegments[0], Integer(buf[j]) shl (j*8)); end; if (FDatabaseType = GEOIP_ORG_EDITION) or (FDatabaseType = GEOIP_ISP_EDITION) then FRecordLength := ORG_RECORD_LENGTH; end; Break; end else begin FInputFile.Seek(-4, soFromCurrent); end; end; if (FDatabaseType = GEOIP_COUNTRY_EDITION) or (FDatabaseType = GEOIP_PROXY_EDITION) then begin SetLength(FDatabaseSegments, 1); FDatabaseSegments[0] := COUNTRY_BEGIN; end; end; function TGeoIP.SeekRecord(IPNum: Cardinal): Cardinal; var depth: Cardinal; offset: Cardinal; i,j: Cardinal; x: array[0..1] of Cardinal; y: Cardinal; buf: array[0..2*MAX_RECORD_LENGTH-1] of Byte; begin offset := 0; for depth:=31 downto 0 do begin FInputFile.Seek(2 * FRecordLength * offset, soFromBeginning); FInputFile.Read(buf, 2 * FRecordLength); for i:=0 to 1 do begin x[i] := 0; for j:=0 to FRecordLength-1 do begin y := buf[i*FRecordLength+j]; x[i] := x[i] + (y shl (j*8)); end; end; if (IPNum and (1 shl depth)) <> 0 then begin if x[1] >= FDatabaseSegments[0] then begin Result := x[1]; Exit; end else begin Offset := x[1]; end; end else begin if x[0] >= FDatabaseSegments[0] then begin Result := x[0]; Exit; end else begin Offset := x[0]; end; end; end; Result := 0; end; end.
  9. columns : ID , username , password , email ,etc.
×
×
  • Create New...