unit httpThread;
interface
uses
Classes, SysUtils, Dialogs, Forms, Controls, ShellAPI, Windows,
IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, IdURI, IdCookieManager,
IdIOHandler, IdIOHandlerSocket, IdIOHandlerStack, IdSSL, IdSSLOpenSSL, IdCoder,
xmldom, XMLIntf, msxmldom, XMLDoc;
type
http =
class(TThread)
private
{ Private-Deklarationen }
fhttp: TIdHttp;
fUser, fPass, fHardwarekennung, fURL, fcfg, fsrc, fsalt:
string;
protected
procedure Execute;
override;
public
constructor Create(User, Pass, Hardwarekennung,
URL, cfg, src, salt:widestring);
end;
implementation
uses main, downloadForm, languageStrings, passwordForm, functions, debug;
constructor http.Create(User, Pass, Hardwarekennung,
URL, cfg, src, salt:widestring);
begin
inherited Create(False);
FreeOnTerminate := true;
fUser := User;
fPass := Pass;
fHardwarekennung := Hardwarekennung;
fURL :=
url;
fcfg := cfg;
fsrc := src;
fsalt := salt;
Self.Execute;
end;
procedure http.Execute;
var s,sFilename,pfad,s1:
string; nlist,flist:iXMLNodeList; cfgdata: tstringlist; PHPXML: IXMLDOCUMENT; sFile: TStream; fparams, currentList:tstringlist; i:integer; Handle1:THandle; fileStream:THandleStream;
begin
phpxml := NewXMLDocument;
fhttp := TIdHTTP.Create(
nil);
try
fhttp.HandleRedirects := True;
fhttp.AllowCookies := True;
fhttp.ReadTimeout := 15000;
//Sonst Timeouts auf > Windows 8 BSystemen
fhttp.IOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(fhttp);
fparams:=tstringlist.Create;
fparams.Add('
RPC=login');
fparams.Add('
username='+fUser);
fparams.Add('
password='+fPass);
fparams.Add('
hardware='+fHardwarekennung);
s := fhttp.Post(TIdURI.URLEncode(fURL), fparams);
try PHPXML.LoadFromXML(s); phpxml.Active := true;
except end;
if not PHPXML.IsEmptyDoc
then
begin
if (phpxml.DocumentElement.HasChildNodes)
then
begin
nlist := phpxml.DocumentElement.ChildNodes;
if (nlist.FindNode('
problem') <>
nil)
then
begin
if (((nlist.FindNode('
blocked') <>
nil))
and (nlist.FindNode('
blocked').Text>'
0000-00-00 00:00:00'))
or (((nlist.FindNode('
removed') <>
nil))
and (nlist.FindNode('
removed').Text>'
0000-00-00 00:00:00'))
then begin try DeleteFile(PChar(fcfg));
except end; Application.Terminate;
end;
Queue(
procedure begin showmessage(language.Label1.Caption)
end );
//'Username or password not valid. Please check your input.'
exit;
end;
//setIniFile;
//Neues Password TODO
//if (((nlist.FindNode('newpassword') <> nil)) and (nlist.FindNode('newpassword').Text='1')) then Form12.ShowModal;
//XML Verschlüsseln und Speichern
try DeleteFile(PChar(fcfg))
except end;
try Queue(
procedure begin Form1.xml.LoadFromXML(Form1.IdDecoderMIME1.DecodeString(nlist.FindNode('
cfg').Text, SysUtils.TUTF8Encoding.UTF8));
cfgdata := tstringlist.Create;
try cfgdata.Text := functions.Encrypt(Form1.xml.XML.Text, fsalt + fUser + fPass + fHardwarekennung); cfgdata.SaveToFile(fcfg);
finally cfgdata.Free;
end;
end );
except end;
//APPLICATION UPDATE
//Versionscheck und ggf. Download der aktuellen Version
if (nlist.FindNode('
version') <>
nil)
then if (phpxml.DocumentElement.ChildNodes.FindNode('
version').Text <> GetVersion)
then if (MessageDlg(language.Label4.caption + phpxml.DocumentElement.ChildNodes.FindNode('
version').Text + '
!' + #13#10 + language.label5.caption, mtConfirmation, mbYesNo, 0) = mrYes)
then
begin
//download.Show;
sFilename := extractfilepath(paramstr(0)) + '
update.exe';
try deletefile(PChar(sFilename))
except;
end;
sFile := TFileStream.Create(sFilename, fmCreate);
try
fparams.text := '
RPC=update';
fhttp.Post(TIdURI.URLEncode(fURL), fparams, sFile);
finally
sFile.Free;
end;
ShellExecute(
handle,'
open',PChar(sFilename), PChar('
'),'
',SW_SHOWNORMAL);
///SP- /VERYSILENT
application.Terminate;
end;
//CONTENT UPDATE
currentList := tstringlist.Create;
try
currentList.Sorted:=true;
functions.FindAllFilesUnix(currentList,fsrc,'
*',true,false,true,true);
//Dateiliste erstellen
pfad:=extractfilepath(paramstr(0));
s1 := phpxml.DocumentElement.ChildNodes.FindNode('
filelist').XML;
for i := currentList.Count-1
downto 0
do
begin
s := copy(currentList[i], length(fsrc) + 1);
s := copy(s, 0, pos(#255, s)-1);
if (pos('
\', s) < 1)
and ((extractfileext(s) = '
')
or (lowercase(extractfileext(s)) = '
.xml'))
then continue;
//APPDATEN: Übergehen - Dateien ohne Endung, Dateien mit Endung XML
s := copy(currentList[i], length(pfad) + 1);
s := copy(s, 0, pos(#255, s)-1);
if (pos('
>' + s + '
</file>', s1) < 1)
then Deletefile(PChar(s));
//löschen
end;
flist := phpxml.DocumentElement.ChildNodes.FindNode('
filelist').ChildNodes;
Queue (
procedure begin Form2.log('
flist.count: ' + inttostr(flist.Count));
end);
for i := flist.Count-1
downto 0
do
begin
if (pos(flist[i].NodeValue + #255 + flist[i].Attributes['
timestamp'], currentList.Text) > 0)
then continue;
//Datumsvergleich
Queue (
procedure begin Form2.log('
entry ' + inttostr(i) + '
: ' + flist[i].NodeValue + #255 + flist[i].Attributes['
timestamp']);
end);
//Download
sFilename := extractfilepath(paramstr(0)) + flist[i].NodeValue;
sFile := TFileStream.Create(sFilename, fmCreate);
//Handle1 := CreateFile(PChar(sFilename), GENERIC_WRITE, FILE_SHARE_WRITE, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
//fileStream := THandleStream.Create(Handle1);
try
fparams.Text := '
RPC=download';
fparams.Add('
file=' + flist[i].NodeValue);
fhttp.Post(TIdURI.URLEncode(fURL), fparams, sFile);
//sFile fileStream
finally
//fhttp.Disconnect;
//fhttp.Response.Clear;
sFile.Free;
//fileStream.Free;
//CloseHandle(Handle1);
SetFileDate(sFilename, UnixToDateTime(flist[i].Attributes['
timestamp']));
end;
end;
finally
currentList.Free;
end;
//Applikation laden
end;
end else Queue(
procedure begin showmessage(language.Label2.Caption);
{problem connecting server} {TODO Offline Modus starten} end );
finally
try fparams.text := '
RPC=logout'; fhttp.Post(TIdURI.URLEncode(fURL), fparams);
except end;
fhttp.Free;
fparams.Free;
end;
Self.Terminate;
end;
end.
Sprachen und Entwicklungsumgebungen
Zitat
Baum-Darstellung
