mirror of
https://github.com/cheat-engine/cheat-engine
synced 2026-08-15 02:26:08 -04:00
522 lines
11 KiB
ObjectPascal
Executable file
522 lines
11 KiB
ObjectPascal
Executable file
unit LuaInternet;
|
|
|
|
{$mode delphi}
|
|
|
|
interface
|
|
|
|
|
|
|
|
|
|
uses
|
|
Classes, SysUtils
|
|
{$ifdef windows}, wininet
|
|
{$else}
|
|
, fphttpclient,opensslsockets,openssl, StringHashList
|
|
|
|
{$endif}
|
|
;
|
|
|
|
{$ifndef standalone}
|
|
procedure initializeLuaInternet;
|
|
{$endif}
|
|
|
|
type
|
|
TWinInternet=class
|
|
private
|
|
{$ifdef windows}
|
|
internet: HINTERNET;
|
|
fheader: string;
|
|
{$else}
|
|
fname: string;
|
|
internet: TFPHTTPClient;
|
|
|
|
|
|
procedure setHeader(s: string);
|
|
function getHeader: string;
|
|
procedure recreateFPHTTPClient;
|
|
procedure storeCookies(urlstring: string);
|
|
procedure loadCookies(urlstring: string);
|
|
{$endif}
|
|
public
|
|
function getURL(urlstring: string; results: tstream): boolean;
|
|
function postURL(urlstring: string; urlencodedpostdata: string; results: tstream): boolean;
|
|
constructor create(name: string);
|
|
destructor destroy; override;
|
|
published
|
|
{$ifdef windows}
|
|
property Header: string read fheader write fheader;
|
|
{$else}
|
|
property Header: string read getHeader write setHeader;
|
|
{$endif}
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
uses {$ifdef darwin}macport, registry,{$endif}{$ifndef standalone}MainUnit2, lua, LuaClass, LuaObject, LuaHandler,{$endif} URIParser, dialogs;
|
|
|
|
{$ifndef windows}
|
|
var cookies: tstringhashlist;
|
|
{$endif}
|
|
|
|
{$ifndef windows}
|
|
procedure TWinInternet.setHeader(s: string);
|
|
begin
|
|
internet.RequestHeaders.Text:=s;
|
|
end;
|
|
|
|
function TWinInternet.getHeader: string;
|
|
begin
|
|
result:=internet.RequestHeaders.Text;
|
|
end;
|
|
|
|
procedure TWinInternet.storeCookies(urlstring: string);
|
|
var
|
|
uri: TURI;
|
|
c: tstringlist;
|
|
i,j: integer;
|
|
s: string;
|
|
cname,cname2: string;
|
|
cvalue,cvalue2: string;
|
|
found: boolean;
|
|
|
|
p: integer;
|
|
begin
|
|
if internet.Cookies.Text='' then exit; //no new cookies
|
|
|
|
uri:=ParseURI(urlstring);
|
|
c:=cookies[uri.Host];
|
|
if c=nil then
|
|
begin
|
|
c:=tstringlist.create;
|
|
cookies[uri.Host]:=c;
|
|
end;
|
|
|
|
|
|
//update the cookies with the new values
|
|
for i:=0 to internet.ResponseHeaders.count-1 do
|
|
begin
|
|
s:=internet.ResponseHeaders[i];
|
|
if (LowerCase(Copy(S,1,10))='set-cookie') then
|
|
begin
|
|
Delete(s,1,Pos(':',S));
|
|
|
|
cname:=trim(copy(s,1,pos('=',s)-1));
|
|
|
|
|
|
cvalue:=trim(copy(s,pos('=',s)+1));
|
|
cvalue:=copy(cvalue,1,pos(';',cvalue)-1);
|
|
|
|
found:=false;
|
|
for j:=0 to c.Count-1 do
|
|
begin
|
|
s:=c[j];
|
|
cname2:=trim(copy(s,1,pos('=',s)-1));
|
|
if cname=cname2 then
|
|
begin
|
|
c[j]:=cname+'='+cvalue; //update
|
|
found:=true;
|
|
break;
|
|
end;
|
|
end;
|
|
|
|
if not found then
|
|
c.add(cname+'='+cvalue);
|
|
end;
|
|
end;
|
|
|
|
|
|
end;
|
|
|
|
procedure TWinInternet.loadCookies(urlstring: string);
|
|
var
|
|
uri: TURI;
|
|
c: tstringlist;
|
|
begin
|
|
uri:=ParseURI(urlstring);
|
|
|
|
c:=cookies[uri.Host];
|
|
if c<>nil then
|
|
begin
|
|
internet.Cookies.Text:=c.text;
|
|
end;
|
|
end;
|
|
|
|
function TWinInternet.postURL(urlstring: string; urlencodedpostdata: string; results: tstream): boolean;
|
|
begin
|
|
result:=false;
|
|
try
|
|
recreateFPHTTPClient;
|
|
loadCookies(urlstring);
|
|
|
|
internet.FormPost(urlstring,urlencodedpostdata,results);
|
|
|
|
storeCookies(urlstring);
|
|
|
|
result:=true;
|
|
except
|
|
result:=false;
|
|
end;
|
|
end;
|
|
|
|
function TWinInternet.getURL(urlstring: string; results: tstream): boolean;
|
|
begin
|
|
result:=false;
|
|
try
|
|
loadCookies(urlstring);
|
|
internet.Get(urlstring, results);
|
|
|
|
storeCookies(urlstring);
|
|
result:=true;
|
|
except
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
procedure TWinInternet.recreateFPHTTPClient;
|
|
begin
|
|
if internet<>nil then
|
|
freeandnil(internet);
|
|
|
|
internet:=TFPHTTPClient.Create(nil);
|
|
internet.AddHeader('User-Agent',fname);
|
|
internet.AllowRedirect:=true;
|
|
end;
|
|
|
|
{$else}
|
|
|
|
function TWinInternet.postURL(urlstring: string; urlencodedpostdata: string; results: tstream): boolean;
|
|
var
|
|
url: HINTERNET;
|
|
|
|
c,r: HInternet;
|
|
available,actualread: dword;
|
|
|
|
buf: PByteArray;
|
|
|
|
u: TURI;
|
|
|
|
port: dword;
|
|
|
|
username, password: pchar;
|
|
|
|
h: string;
|
|
requestflags: dword;
|
|
err: integer;
|
|
begin
|
|
h:='Content-Type: application/x-www-form-urlencoded';
|
|
|
|
result:=false;
|
|
if internet<>nil then
|
|
begin
|
|
//InternetConnect(internet, );
|
|
|
|
requestflags:=INTERNET_FLAG_PRAGMA_NOCACHE;
|
|
|
|
u:=ParseURI(urlstring);
|
|
|
|
port:=INTERNET_DEFAULT_HTTP_PORT;
|
|
if lowercase(u.Protocol)='https' then
|
|
begin
|
|
port:=INTERNET_DEFAULT_HTTPS_PORT;
|
|
requestflags:=requestflags or INTERNET_FLAG_SECURE;
|
|
end
|
|
else
|
|
begin
|
|
// requestflags:=requestflags or INTERNET_FLAG_NO_AUTO_REDIRECT;
|
|
end;
|
|
|
|
if u.Port<>0 then
|
|
port:=u.port;
|
|
|
|
if u.Username<>'' then
|
|
username:=pchar(u.Username)
|
|
else
|
|
username:=nil;
|
|
|
|
if u.Password<>'' then
|
|
password:=pchar(u.Password)
|
|
else
|
|
password:=nil;
|
|
|
|
if u.params<>'' then u.params:='?'+u.params;
|
|
|
|
|
|
c:=InternetConnect(internet, pchar(u.Host), port, username, password, INTERNET_SERVICE_HTTP, 0,0);
|
|
if c<>nil then
|
|
begin
|
|
r:=HttpOpenRequest(c, PChar('POST'), pchar(u.path+u.Document+u.Params), nil, nil, nil, requestflags, 0);
|
|
if r<>nil then
|
|
begin
|
|
if HttpSendRequest(r,pchar(h),length(h),pchar(urlencodedpostdata), length(urlencodedpostdata)) then
|
|
begin
|
|
|
|
while InternetQueryDataAvailable(r, available, 0, 0) do
|
|
begin
|
|
if available=0 then break;
|
|
|
|
getmem(buf, available+32);
|
|
try
|
|
if InternetReadFile(r, buf, available,actualread)=false then break;
|
|
if actualread>0 then
|
|
begin
|
|
results.WriteBuffer(buf[0], actualread);
|
|
result:=true; //something was read
|
|
end;
|
|
finally
|
|
FreeMemAndNil(buf);
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
err:=getLastOSError;
|
|
|
|
if err=0 then beep;
|
|
|
|
|
|
end;
|
|
|
|
InternetCloseHandle(r);
|
|
end;
|
|
|
|
InternetCloseHandle(c);
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
function TWinInternet.getURL(urlstring: string; results: tstream): boolean;
|
|
var url: HINTERNET;
|
|
available,actualread: dword;
|
|
|
|
buf: PByteArray;
|
|
begin
|
|
result:=false;
|
|
if internet<>nil then
|
|
begin
|
|
if header='' then
|
|
url:=InternetOpenUrl(internet, pchar(urlstring),nil,0,INTERNET_FLAG_PRAGMA_NOCACHE or INTERNET_FLAG_RESYNCHRONIZE or INTERNET_FLAG_DONT_CACHE, 0)
|
|
else
|
|
url:=InternetOpenUrl(internet, pchar(urlstring), @fheader[1], length(fheader), INTERNET_FLAG_PRAGMA_NOCACHE or INTERNET_FLAG_RESYNCHRONIZE or INTERNET_FLAG_DONT_CACHE,0);
|
|
|
|
if url=nil then exit;
|
|
|
|
while InternetQueryDataAvailable(url, available, 0, 0) do
|
|
begin
|
|
if available=0 then break;
|
|
|
|
getmem(buf, available+32);
|
|
try
|
|
if InternetReadFile(url, buf, available+32,actualread)=false then break;
|
|
if actualread>0 then
|
|
begin
|
|
results.WriteBuffer(buf[0], actualread);
|
|
result:=true; //something was read
|
|
end;
|
|
finally
|
|
FreeMemAndNil(buf);
|
|
end;
|
|
end;
|
|
|
|
InternetCloseHandle(url);
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{$endif}
|
|
|
|
|
|
constructor TWinInternet.create(name: string);
|
|
begin
|
|
|
|
{$ifdef windows}
|
|
internet:=InternetOpen(pchar(name),0, nil, nil,0);
|
|
{$else}
|
|
|
|
|
|
|
|
fname:=name;
|
|
openssl.DLLVersions[1]:=openssl.DLLVersions[2];
|
|
openssl.DLLVersions[1]:='.46';
|
|
openssl.DLLVersions[2]:='.44';
|
|
InitSSLInterface;
|
|
openssl.ErrClearError;
|
|
|
|
recreateFPHTTPClient;
|
|
|
|
{$endif}
|
|
end;
|
|
|
|
destructor TWinInternet.destroy;
|
|
begin
|
|
if internet<>nil then
|
|
{$ifdef windows}
|
|
InternetCloseHandle(internet);
|
|
{$else}
|
|
freeandnil(internet);
|
|
{$endif}
|
|
|
|
|
|
inherited destroy;
|
|
end;
|
|
|
|
{$ifndef standalone}
|
|
|
|
function getInternet(L: Plua_State): integer; cdecl;
|
|
begin
|
|
if lua_gettop(l)>0 then
|
|
luaclass_newClass(L, TWinInternet.create({$ifdef altname}'Cheat Engine'{$else}cename{$endif}+' : luascript-'+Lua_ToString(L,1)))
|
|
else
|
|
luaclass_newClass(L, TWinInternet.create({$ifdef altname}'Cheat Engine'{$else}cename{$endif}+' : luascript'));
|
|
|
|
result:=1;
|
|
end;
|
|
|
|
function wininternet_getURL(L: Plua_State): integer; cdecl;
|
|
var
|
|
i: TWinInternet;
|
|
s: TMemoryStream;
|
|
begin
|
|
result:=0;
|
|
i:=luaclass_getClassObject(L);
|
|
if lua_gettop(L)>=1 then
|
|
begin
|
|
s:=TMemoryStream.create;
|
|
try
|
|
if i.getURL(Lua_ToString(L, -1), s) then
|
|
begin
|
|
lua_pushlstring(L, s.Memory, s.Size);
|
|
result:=1;
|
|
end;
|
|
finally
|
|
s.free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function wininternet_postURL(L: Plua_State): integer; cdecl;
|
|
var
|
|
i: TWinInternet;
|
|
s: TMemoryStream;
|
|
param: string;
|
|
begin
|
|
result:=0;
|
|
i:=luaclass_getClassObject(L);
|
|
if lua_gettop(L)>=1 then
|
|
begin
|
|
s:=TMemoryStream.create;
|
|
try
|
|
if lua_gettop(L)>=2 then
|
|
param:=Lua_ToString(L, 2)
|
|
else
|
|
param:='';
|
|
|
|
if i.postURL(Lua_ToString(L, 1), param, s) then
|
|
begin
|
|
lua_pushlstring(L, s.Memory, s.Size);
|
|
result:=1;
|
|
end;
|
|
finally
|
|
s.free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure wininternet_addMetaData(L: PLua_state; metatable: integer; userdata: integer );
|
|
begin
|
|
object_addMetaData(L, metatable, userdata);
|
|
luaclass_addClassFunctionToTable(L, metatable, userdata, 'getURL', wininternet_getURL);
|
|
luaclass_addClassFunctionToTable(L, metatable, userdata, 'postURL', wininternet_postURL);
|
|
|
|
end;
|
|
|
|
procedure initializeLuaInternet;
|
|
begin
|
|
lua_register(LuaVM, 'getInternet', getInternet);
|
|
end;
|
|
|
|
{$ifndef windows}
|
|
procedure loadCookiesFromRegistry;
|
|
var
|
|
r: TRegistry;
|
|
names: tstringlist;
|
|
i: integer;
|
|
c: tstringlist;
|
|
begin
|
|
macPortFixRegPath;
|
|
r:=tregistry.Create;
|
|
r.RootKey:=HKEY_CURRENT_USER;
|
|
try
|
|
if r.OpenKey('Cookies',false) then
|
|
begin
|
|
names:=tstringlist.create;
|
|
|
|
try
|
|
r.GetValueNames(names);
|
|
for i:=0 to names.count-1 do
|
|
begin
|
|
c:=tstringlist.create;
|
|
r.ReadStringList(names[i],c);
|
|
cookies[names[i]]:=c;
|
|
end;
|
|
finally
|
|
names.free;
|
|
end;
|
|
end;
|
|
|
|
except
|
|
end;
|
|
|
|
r.free;
|
|
end;
|
|
|
|
procedure saveCookiesToRegistry;
|
|
var
|
|
r: TRegistry;
|
|
i: integer;
|
|
|
|
e: PStringHashItem;
|
|
host: string;
|
|
begin
|
|
r:=TRegistry.Create;
|
|
r.RootKey:=HKEY_CURRENT_USER;
|
|
|
|
if r.OpenKey('Cookies',true) then
|
|
begin
|
|
for i:=0 to cookies.count-1 do
|
|
begin
|
|
e:=cookies.List[i];
|
|
if e<>nil then
|
|
begin
|
|
host:=e^.Key;
|
|
r.WriteStringList(host,tstringlist(e^.Data));
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
|
r.free;
|
|
end;
|
|
{$endif}
|
|
|
|
initialization
|
|
{$ifndef windows}
|
|
cookies:=TStringHashList.Create(false);
|
|
loadCookiesFromRegistry;
|
|
{$endif}
|
|
|
|
luaclass_register(TWinInternet, wininternet_addMetaData);
|
|
|
|
{$ifndef windows}
|
|
finalization
|
|
|
|
saveCookiesToRegistry;
|
|
{$endif}
|
|
{$endif}
|
|
|
|
end.
|
|
|