-
Posts
188 -
Joined
-
Last visited
About Celtic88
- Birthday 02/13/1995
Profile Information
-
Location
ALGERIA
Recent Profile Visitors
785 profile views
Celtic88's Achievements
Prodigy (4/7)
21
Reputation
-
boludoz reacted to a post in a topic: Splitting a File to Byte Array
-
RTFC reacted to a post in a topic: Autoit api thread * update
-
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
-
mLipok reacted to a post in a topic: Autoit api thread * update
-
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
-
I have a problem with WinHttp..
Celtic88 replied to Celtic88's topic in AutoIt General Help and Support
@TheXman , did you try? -
I have a problem with WinHttp..
Celtic88 replied to Celtic88's topic in AutoIt General Help and Support
Not possible with WinHttp ? -
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)
-
a problem when using dllCall function
Celtic88 replied to nacerbaaziz's topic in AutoIt General Help and Support
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) -
Celtic88 reacted to a post in a topic: Chromium Embedded Framework for AutoIt3
-
coffeeturtle reacted to a post in a topic: Tcp event
-
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()
-
lequocvan reacted to a post in a topic: Take webcam screenshot
-
Celtic88 reacted to a post in a topic: LEDkIt - WIP
-
try with _IsPressed()
-
Celtic88 reacted to a post in a topic: GDI+ Firework for New Year's Eve with sound fx build 2016-01-08
-
Celtic88 reacted to a post in a topic: Multi-line items in custom drawn ListView
-
Celtic88 reacted to a post in a topic: Checkboxes, overlay icons and state images in ListViews
-
autoit multithreaded?
Celtic88 replied to rietproductions's topic in AutoIt General Help and Support
you can use multi process method! -
Waw Superb, thank you
-
KFUPM reacted to a post in a topic: Splitting a File to Byte Array
-
SkythekidRS reacted to a post in a topic: Get full address tree view ( sorry about bad english)
-
Celtic88 reacted to a post in a topic: Simple Compression
-
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
-
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.
-
Celtic88 reacted to a post in a topic: Episode Seeker
-
columns : ID , username , password , email ,etc.