diff options
Diffstat (limited to 'plugins/MirandaNGHistoryToDB/IMDownloaderComponent')
12 files changed, 1699 insertions, 0 deletions
diff --git a/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTest.dpr b/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTest.dpr new file mode 100644 index 0000000000..8942f8b61d --- /dev/null +++ b/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTest.dpr @@ -0,0 +1,15 @@ +program DownLoaderTest;
+
+uses
+ Forms,
+ DownLoaderTestUnit in 'DownLoaderTestUnit.pas' {MainForm};
+
+{$R *.res}
+
+begin
+ Application.Initialize;
+ Application.MainFormOnTaskbar := True;
+ Application.Title := 'IM Downloader Demo';
+ Application.CreateForm(TMainForm, MainForm);
+ Application.Run;
+end.
diff --git a/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTest.dproj b/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTest.dproj new file mode 100644 index 0000000000..c0b14483c0 --- /dev/null +++ b/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTest.dproj @@ -0,0 +1,109 @@ +п»ї <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+ <PropertyGroup>
+ <ProjectGuid>{8B841E47-C817-4F26-8ACF-89048F0E7C42}</ProjectGuid>
+ <MainSource>DownLoaderTest.dpr</MainSource>
+ <Base>True</Base>
+ <Config Condition="'$(Config)'==''">Release</Config>
+ <Platform>Win32</Platform>
+ <AppType>Application</AppType>
+ <FrameworkType>VCL</FrameworkType>
+ <DCC_DCCCompiler>DCC32</DCC_DCCCompiler>
+ <ProjectVersion>12.3</ProjectVersion>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
+ <Base>true</Base>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_1)'!=''">
+ <Cfg_1>true</Cfg_1>
+ <CfgParent>Base</CfgParent>
+ <Base>true</Base>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_2)'!=''">
+ <Cfg_2>true</Cfg_2>
+ <CfgParent>Base</CfgParent>
+ <Base>true</Base>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Base)'!=''">
+ <DCC_ImageBase>00400000</DCC_ImageBase>
+ <DCC_E>false</DCC_E>
+ <DCC_S>false</DCC_S>
+ <DCC_F>false</DCC_F>
+ <DCC_N>false</DCC_N>
+ <DCC_K>false</DCC_K>
+ <DCC_UnitAlias>WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;WinTypes=Windows;WinProcs=Windows;$(DCC_UnitAlias)</DCC_UnitAlias>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Cfg_1)'!=''">
+ <DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
+ <DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
+ <DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
+ <DCC_DebugInformation>false</DCC_DebugInformation>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Cfg_2)'!=''">
+ <DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
+ <DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
+ <DCC_Optimize>false</DCC_Optimize>
+ </PropertyGroup>
+ <ItemGroup>
+ <DelphiCompile Include="DownLoaderTest.dpr">
+ <MainSource>MainSource</MainSource>
+ </DelphiCompile>
+ <DCCReference Include="DownLoaderTestUnit.pas">
+ <Form>MainForm</Form>
+ </DCCReference>
+ <BuildConfiguration Include="Debug">
+ <Key>Cfg_2</Key>
+ <CfgParent>Base</CfgParent>
+ </BuildConfiguration>
+ <BuildConfiguration Include="Base">
+ <Key>Base</Key>
+ </BuildConfiguration>
+ <BuildConfiguration Include="Release">
+ <Key>Cfg_1</Key>
+ <CfgParent>Base</CfgParent>
+ </BuildConfiguration>
+ </ItemGroup>
+ <Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
+ <Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/>
+ <ProjectExtensions>
+ <Borland.Personality>Delphi.Personality.12</Borland.Personality>
+ <Borland.ProjectType>VCLApplication</Borland.ProjectType>
+ <BorlandProject>
+ <Delphi.Personality>
+ <Source>
+ <Source Name="MainSource">DownLoaderTest.dpr</Source>
+ </Source>
+ <VersionInfo>
+ <VersionInfo Name="IncludeVerInfo">False</VersionInfo>
+ <VersionInfo Name="AutoIncBuild">False</VersionInfo>
+ <VersionInfo Name="MajorVer">1</VersionInfo>
+ <VersionInfo Name="MinorVer">0</VersionInfo>
+ <VersionInfo Name="Release">0</VersionInfo>
+ <VersionInfo Name="Build">0</VersionInfo>
+ <VersionInfo Name="Debug">False</VersionInfo>
+ <VersionInfo Name="PreRelease">False</VersionInfo>
+ <VersionInfo Name="Special">False</VersionInfo>
+ <VersionInfo Name="Private">False</VersionInfo>
+ <VersionInfo Name="DLL">False</VersionInfo>
+ <VersionInfo Name="Locale">1049</VersionInfo>
+ <VersionInfo Name="CodePage">1251</VersionInfo>
+ </VersionInfo>
+ <VersionInfoKeys>
+ <VersionInfoKeys Name="CompanyName"/>
+ <VersionInfoKeys Name="FileDescription"/>
+ <VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys>
+ <VersionInfoKeys Name="InternalName"/>
+ <VersionInfoKeys Name="LegalCopyright"/>
+ <VersionInfoKeys Name="LegalTrademarks"/>
+ <VersionInfoKeys Name="OriginalFilename"/>
+ <VersionInfoKeys Name="ProductName"/>
+ <VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
+ <VersionInfoKeys Name="Comments"/>
+ </VersionInfoKeys>
+ </Delphi.Personality>
+ <Platforms>
+ <Platform value="Win32">True</Platform>
+ </Platforms>
+ </BorlandProject>
+ <ProjectFileVersion>12</ProjectFileVersion>
+ </ProjectExtensions>
+ </Project>
diff --git a/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTest.res b/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTest.res Binary files differnew file mode 100644 index 0000000000..fc1937e1c7 --- /dev/null +++ b/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTest.res diff --git a/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTestUnit.dfm b/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTestUnit.dfm new file mode 100644 index 0000000000..b245bf8704 --- /dev/null +++ b/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTestUnit.dfm @@ -0,0 +1,125 @@ +object MainForm: TMainForm
+ Left = 0
+ Top = 0
+ Caption = 'TIMDownloadThread Test'
+ ClientHeight = 252
+ ClientWidth = 608
+ Color = clBtnFace
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'Tahoma'
+ Font.Style = []
+ OldCreateOrder = False
+ Position = poDesktopCenter
+ OnShow = FormShow
+ PixelsPerInch = 96
+ TextHeight = 13
+ object ToolBar1: TToolBar
+ Left = 0
+ Top = 0
+ Width = 608
+ Height = 25
+ ButtonHeight = 27
+ ButtonWidth = 79
+ Caption = 'ToolBar1'
+ List = True
+ ShowCaptions = True
+ TabOrder = 0
+ object Edit1: TEdit
+ Left = 0
+ Top = 0
+ Width = 385
+ Height = 27
+ TabOrder = 0
+ end
+ object TBDownload: TToolButton
+ Left = 385
+ Top = 0
+ AutoSize = True
+ Caption = #1057#1082#1072#1095#1072#1090#1100
+ ImageIndex = 0
+ OnClick = TBDownloadClick
+ end
+ object TBStopDownload: TToolButton
+ Left = 444
+ Top = 0
+ AutoSize = True
+ Caption = #1054#1089#1090#1072#1085#1086#1074#1080#1090#1100
+ ImageIndex = 1
+ Visible = False
+ OnClick = TBStopDownloadClick
+ end
+ object TBView: TToolButton
+ Left = 521
+ Top = 0
+ AutoSize = True
+ Caption = #1042#1099#1074#1077#1089#1090#1080
+ DropdownMenu = PopupMenu1
+ ImageIndex = 2
+ Style = tbsDropDown
+ Visible = False
+ OnClick = TBViewClick
+ end
+ end
+ object StatusBar1: TStatusBar
+ Left = 0
+ Top = 233
+ Width = 608
+ Height = 19
+ Panels = <>
+ SimplePanel = True
+ end
+ object RichEdit1: TRichEdit
+ Left = 0
+ Top = 25
+ Width = 608
+ Height = 191
+ Align = alClient
+ Font.Charset = RUSSIAN_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'Tahoma'
+ Font.Style = []
+ ParentFont = False
+ ReadOnly = True
+ ScrollBars = ssBoth
+ TabOrder = 2
+ end
+ object ProgressBar1: TProgressBar
+ Left = 0
+ Top = 216
+ Width = 608
+ Height = 17
+ Align = alBottom
+ TabOrder = 3
+ end
+ object IMDownloader_Demo: TIMDownloader
+ OnError = IMDownloader_DemoError
+ OnAccepted = IMDownloader_DemoAccepted
+ OnHeaders = IMDownloader_DemoHeaders
+ OnMD5Checked = IMDownloader_DemoMD5Checked
+ OnDownloading = IMDownloader_DemoDownloading
+ OnStartDownload = IMDownloader_DemoStartDownload
+ OnBreak = IMDownloader_DemoBreak
+ Left = 72
+ Top = 40
+ end
+ object SaveDialog1: TSaveDialog
+ Left = 136
+ Top = 96
+ end
+ object PopupMenu1: TPopupMenu
+ Left = 224
+ Top = 120
+ object ViewAsTest: TMenuItem
+ Caption = #1054#1090#1086#1073#1088#1072#1079#1080#1090#1100' '#1082#1072#1082' '#1090#1077#1082#1089#1090
+ Default = True
+ OnClick = ViewAsTestClick
+ end
+ object SaveToFile: TMenuItem
+ Caption = #1057#1086#1093#1088#1072#1085#1080#1090#1100' '#1074' '#1092#1072#1081#1083
+ OnClick = SaveToFileClick
+ end
+ end
+end
diff --git a/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTestUnit.pas b/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTestUnit.pas new file mode 100644 index 0000000000..2ca42ac174 --- /dev/null +++ b/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTestUnit.pas @@ -0,0 +1,176 @@ +unit DownLoaderTestUnit;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+ Dialogs, uIMDownLoader, StdCtrls, ToolWin, ComCtrls, Menus;
+
+type
+ TMainForm = class(TForm)
+ IMDownloader_Demo: TIMDownloader;
+ Edit1: TEdit;
+ ToolBar1: TToolBar;
+ StatusBar1: TStatusBar;
+ RichEdit1: TRichEdit;
+ SaveDialog1: TSaveDialog;
+ TBDownload: TToolButton;
+ TBStopDownload: TToolButton;
+ TBView: TToolButton;
+ ViewAsTest: TMenuItem;
+ SaveToFile: TMenuItem;
+ PopupMenu1: TPopupMenu;
+ ProgressBar1: TProgressBar;
+ procedure FormShow(Sender: TObject);
+ procedure IMDownloader_DemoError(Sender: TObject; E: TIMDownLoadError);
+ procedure IMDownloader_DemoAccepted(Sender: TObject);
+ procedure IMDownloader_DemoStartDownload(Sender: TObject);
+ procedure IMDownloader_DemoBreak(Sender: TObject);
+ procedure ViewAsTestClick(Sender: TObject);
+ procedure SaveToFileClick(Sender: TObject);
+ procedure TBDownloadClick(Sender: TObject);
+ procedure TBStopDownloadClick(Sender: TObject);
+ procedure TBViewClick(Sender: TObject);
+ procedure IMDownloader_DemoDownloading(Sender: TObject; AcceptedSize, MaxSize: Cardinal);
+ procedure IMDownloader_DemoHeaders(Sender: TObject; Headers: string);
+ procedure IMDownloader_DemoMD5Checked(Sender: TObject; MD5Correct,
+ SizeCorrect: Boolean; MD5Str: string);
+ private
+ { Private declarations }
+ public
+ { Public declarations }
+ end;
+
+var
+ MainForm: TMainForm;
+
+const
+ uURL = 'http://im-history.ru/update/get.php?file=HistoryToDB-Update';
+
+implementation
+
+{$R *.dfm}
+
+procedure TMainForm.FormShow(Sender: TObject);
+begin
+ Edit1.Text := uURL;
+ IMDownloader_Demo.DirPath := ExtractFilePath(Application.ExeName);
+end;
+
+procedure TMainForm.IMDownloader_DemoAccepted(Sender: TObject);
+begin
+ ProgressBar1.Visible := False;
+ TBStopDownload.Visible := false;
+ TBDownload.Visible := true;
+ TBView.Visible := true;
+ Edit1.ReadOnly := false;
+ StatusBar1.SimpleText :=
+ 'Скачивание успешно завершено. Всего получено данных в байтах: ' + IntToStr
+ (IMDownloader_Demo.AcceptedSize);
+ //RichEdit1.Lines.Append('MD5 файла в памяти: '+MD5DigestToStr(MD5Stream(IMDownloader_Demo.OutStream)));
+end;
+
+procedure TMainForm.IMDownloader_DemoBreak(Sender: TObject);
+begin
+ ProgressBar1.Visible := False;
+ TBStopDownload.Visible := false;
+ TBStopDownload.Enabled := true;
+ TBDownload.Visible := true;
+ TBView.Visible := IMDownloader_Demo.AcceptedSize > 0;
+ Edit1.ReadOnly := false;
+ StatusBar1.SimpleText :=
+ 'Скачивание остановлено. Всего получено данных в байтах: ' + IntToStr
+ (IMDownloader_Demo.AcceptedSize);
+end;
+
+procedure TMainForm.IMDownloader_DemoDownloading(Sender: TObject; AcceptedSize,
+ MaxSize: Cardinal);
+begin
+ StatusBar1.SimpleText := 'Получено байт: ' + IntToStr(AcceptedSize);
+ ProgressBar1.Visible := MaxSize > AcceptedSize;
+ ProgressBar1.Max := MaxSize;
+ ProgressBar1.Position := AcceptedSize;
+end;
+
+procedure TMainForm.IMDownloader_DemoError(Sender: TObject; E: TIMDownLoadError);
+var
+ s: string;
+begin
+ ProgressBar1.Visible := False;
+ TBStopDownload.Visible := false;
+ TBDownload.Visible := true;
+ TBView.Visible := IMDownloader_Demo.AcceptedSize > 0;
+ Edit1.ReadOnly := false;
+ case E of
+ deInternetOpen: s := 'Ошибка при открытии сессии. ';
+ deInternetOpenUrl: s := 'Ошибка при запрашивании файла. ';
+ deDownloadingFile: s := 'Ошибка при чтении файла. ';
+ deRequest: s := 'Ошибка при запросе данных через прокси-сервер. ';
+ end;
+ StatusBar1.SimpleText :=
+ s + 'Всего получено данных в байтах: ' + IntToStr
+ (IMDownloader_Demo.AcceptedSize);
+end;
+
+procedure TMainForm.IMDownloader_DemoHeaders(Sender: TObject; Headers: string);
+begin
+ RichEdit1.Lines.Text := Headers;
+end;
+
+procedure TMainForm.IMDownloader_DemoMD5Checked(Sender: TObject; MD5Correct,
+ SizeCorrect: Boolean; MD5Str: string);
+begin
+ if MD5Correct then
+ RichEdit1.Lines.Append('Контрольная сумма MD5 = '+MD5Str+' - ВЕРНА!')
+ else
+ RichEdit1.Lines.Append('Контрольная сумма MD5 = '+MD5Str+' - НЕ ВЕРНА!');
+ if SizeCorrect then
+ RichEdit1.Lines.Append('Размер файла = '+IntToStr(IMDownloader_Demo.AcceptedSize)+' - ВЕРНЫЙ!')
+ else
+ RichEdit1.Lines.Append('Размер файла = '+IntToStr(IMDownloader_Demo.AcceptedSize)+' - НЕ ВЕРНЫЙ!');
+end;
+
+procedure TMainForm.IMDownloader_DemoStartDownload(Sender: TObject);
+begin
+ TBDownload.Visible := false;
+ TBStopDownload.Visible := true;
+ TBView.Visible := false;
+ Edit1.ReadOnly := true;
+ StatusBar1.SimpleText := 'Инициализация скачивания...';
+end;
+
+procedure TMainForm.ViewAsTestClick(Sender: TObject);
+begin
+ RichEdit1.Lines.LoadFromStream(IMDownloader_Demo.OutStream);
+end;
+
+procedure TMainForm.SaveToFileClick(Sender: TObject);
+begin
+ if Edit1.Text = uURL then
+ SaveDialog1.FileName := 'HistoryToDBCreateDB.rar';
+ if SaveDialog1.Execute then
+ IMDownloader_Demo.OutStream.SaveToFile(SaveDialog1.FileName);
+end;
+
+procedure TMainForm.TBDownloadClick(Sender: TObject);
+begin
+ IMDownloader_Demo.URL := Edit1.Text;
+ //IMDownloader_Demo.Proxy := '192.168.42.240:1522';
+ IMDownloader_Demo.Proxy := '172.29.72.168:8080';
+ IMDownloader_Demo.Download;
+end;
+
+procedure TMainForm.TBStopDownloadClick(Sender: TObject);
+begin
+ StatusBar1.SimpleText := 'Останавливаем скачку';
+ TBStopDownload.Enabled := false;
+ IMDownloader_Demo.BreakDownload;
+end;
+
+procedure TMainForm.TBViewClick(Sender: TObject);
+begin
+ TBView.DropdownMenu.Popup(TBView.ClientOrigin.X,
+ TBView.ClientOrigin.Y + TBView.Height);
+end;
+
+end.
diff --git a/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader.dcr b/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader.dcr Binary files differnew file mode 100644 index 0000000000..2311dc0fef --- /dev/null +++ b/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader.dcr diff --git a/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader.dpk b/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader.dpk new file mode 100644 index 0000000000..f925b6df62 --- /dev/null +++ b/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader.dpk @@ -0,0 +1,38 @@ +package IMDownloader;
+
+{$R *.res}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO OFF}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS OFF}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO OFF}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE RELEASE}
+{$ENDIF IMPLICITBUILDING}
+{$IMPLICITBUILD ON}
+
+requires
+ rtl,
+ vcl;
+
+contains
+ uIMDownloader in 'uIMDownloader.pas',
+ uMD5 in 'uMD5.pas';
+
+end.
diff --git a/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader.dproj b/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader.dproj new file mode 100644 index 0000000000..092d815fc7 --- /dev/null +++ b/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader.dproj @@ -0,0 +1,168 @@ +п»ї<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+ <PropertyGroup>
+ <ProjectGuid>{BF7E5A55-CA0C-4DDD-B399-17FA1A2FF83F}</ProjectGuid>
+ <MainSource>IMDownloader.dpk</MainSource>
+ <Base>True</Base>
+ <Config Condition="'$(Config)'==''">Release</Config>
+ <AppType>Package</AppType>
+ <FrameworkType>VCL</FrameworkType>
+ <DCC_DCCCompiler>DCC32</DCC_DCCCompiler>
+ <ProjectVersion>14.3</ProjectVersion>
+ <Platform Condition="'$(Platform)'==''">Win32</Platform>
+ <TargetedPlatforms>3</TargetedPlatforms>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
+ <Base>true</Base>
+ </PropertyGroup>
+ <PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
+ <Base_Win32>true</Base_Win32>
+ <CfgParent>Base</CfgParent>
+ <Base>true</Base>
+ </PropertyGroup>
+ <PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Base)'=='true') or '$(Base_Win64)'!=''">
+ <Base_Win64>true</Base_Win64>
+ <CfgParent>Base</CfgParent>
+ <Base>true</Base>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_1)'!=''">
+ <Cfg_1>true</Cfg_1>
+ <CfgParent>Base</CfgParent>
+ <Base>true</Base>
+ </PropertyGroup>
+ <PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''">
+ <Cfg_1_Win32>true</Cfg_1_Win32>
+ <CfgParent>Cfg_1</CfgParent>
+ <Cfg_1>true</Cfg_1>
+ <Base>true</Base>
+ </PropertyGroup>
+ <PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win64)'!=''">
+ <Cfg_1_Win64>true</Cfg_1_Win64>
+ <CfgParent>Cfg_1</CfgParent>
+ <Cfg_1>true</Cfg_1>
+ <Base>true</Base>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_2)'!=''">
+ <Cfg_2>true</Cfg_2>
+ <CfgParent>Base</CfgParent>
+ <Base>true</Base>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Base)'!=''">
+ <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
+ <DCC_Namespace>Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace)</DCC_Namespace>
+ <VerInfo_Build>4</VerInfo_Build>
+ <VerInfo_Locale>1049</VerInfo_Locale>
+ <VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.4;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
+ <DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
+ <DCC_DebugInformation>false</DCC_DebugInformation>
+ <DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
+ <DCC_ImageBase>00400000</DCC_ImageBase>
+ <GenDll>true</GenDll>
+ <DCC_E>false</DCC_E>
+ <DCC_S>false</DCC_S>
+ <DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
+ <DCC_N>false</DCC_N>
+ <GenPackage>true</GenPackage>
+ <DCC_K>false</DCC_K>
+ <DCC_F>false</DCC_F>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Base_Win32)'!=''">
+ <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
+ <Icon_MainIcon>IMDownloader_Icon.ico</Icon_MainIcon>
+ <DCC_Namespace>System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
+ <VerInfo_Locale>1033</VerInfo_Locale>
+ <DCC_UsePackage>vcl;rtl;$(DCC_UsePackage)</DCC_UsePackage>
+ <Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
+ <VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Base_Win64)'!=''">
+ <VerInfo_Locale>1033</VerInfo_Locale>
+ <Icon_MainIcon>IMDownloader_Icon.ico</Icon_MainIcon>
+ <DCC_Namespace>System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace)</DCC_Namespace>
+ <DCC_UsePackage>vcl;rtl;$(DCC_UsePackage)</DCC_UsePackage>
+ <Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
+ <VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
+ <VerInfo_Locale>1033</VerInfo_Locale>
+ <VerInfo_Build>0</VerInfo_Build>
+ <DCC_DcuOutput>.\$(Platform)\$(Config)</DCC_DcuOutput>
+ <VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Cfg_1_Win64)'!=''">
+ <VerInfo_Locale>1033</VerInfo_Locale>
+ <VerInfo_Build>0</VerInfo_Build>
+ <DCC_DcuOutput>.\$(Platform)\$(Config)</DCC_DcuOutput>
+ <VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Cfg_2)'!=''">
+ <DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
+ <DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
+ <DCC_Optimize>false</DCC_Optimize>
+ </PropertyGroup>
+ <ItemGroup>
+ <DelphiCompile Include="$(MainSource)">
+ <MainSource>MainSource</MainSource>
+ </DelphiCompile>
+ <DCCReference Include="rtl.dcp"/>
+ <DCCReference Include="vcl.dcp"/>
+ <DCCReference Include="uIMDownloader.pas"/>
+ <DCCReference Include="uMD5.pas"/>
+ <BuildConfiguration Include="Debug">
+ <Key>Cfg_2</Key>
+ <CfgParent>Base</CfgParent>
+ </BuildConfiguration>
+ <BuildConfiguration Include="Base">
+ <Key>Base</Key>
+ </BuildConfiguration>
+ <BuildConfiguration Include="Release">
+ <Key>Cfg_1</Key>
+ <CfgParent>Base</CfgParent>
+ </BuildConfiguration>
+ </ItemGroup>
+ <Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
+ <Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/>
+ <ProjectExtensions>
+ <Borland.Personality>Delphi.Personality.12</Borland.Personality>
+ <Borland.ProjectType>Package</Borland.ProjectType>
+ <BorlandProject>
+ <Delphi.Personality>
+ <Source>
+ <Source Name="MainSource">IMDownloader.dpk</Source>
+ </Source>
+ <VersionInfo>
+ <VersionInfo Name="IncludeVerInfo">True</VersionInfo>
+ <VersionInfo Name="AutoIncBuild">False</VersionInfo>
+ <VersionInfo Name="MajorVer">1</VersionInfo>
+ <VersionInfo Name="MinorVer">0</VersionInfo>
+ <VersionInfo Name="Release">0</VersionInfo>
+ <VersionInfo Name="Build">4</VersionInfo>
+ <VersionInfo Name="Debug">False</VersionInfo>
+ <VersionInfo Name="PreRelease">False</VersionInfo>
+ <VersionInfo Name="Special">False</VersionInfo>
+ <VersionInfo Name="Private">False</VersionInfo>
+ <VersionInfo Name="DLL">False</VersionInfo>
+ <VersionInfo Name="Locale">1049</VersionInfo>
+ <VersionInfo Name="CodePage">1251</VersionInfo>
+ </VersionInfo>
+ <VersionInfoKeys>
+ <VersionInfoKeys Name="CompanyName"/>
+ <VersionInfoKeys Name="FileDescription"/>
+ <VersionInfoKeys Name="FileVersion">1.0.0.4</VersionInfoKeys>
+ <VersionInfoKeys Name="InternalName"/>
+ <VersionInfoKeys Name="LegalCopyright"/>
+ <VersionInfoKeys Name="LegalTrademarks"/>
+ <VersionInfoKeys Name="OriginalFilename"/>
+ <VersionInfoKeys Name="ProductName"/>
+ <VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
+ <VersionInfoKeys Name="Comments"/>
+ </VersionInfoKeys>
+ <Excluded_Packages/>
+ </Delphi.Personality>
+ <Platforms>
+ <Platform value="Win32">True</Platform>
+ <Platform value="Win64">True</Platform>
+ </Platforms>
+ </BorlandProject>
+ <ProjectFileVersion>12</ProjectFileVersion>
+ </ProjectExtensions>
+</Project>
diff --git a/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader.res b/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader.res Binary files differnew file mode 100644 index 0000000000..ebc501849a --- /dev/null +++ b/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader.res diff --git a/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader_Icon.ico b/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader_Icon.ico Binary files differnew file mode 100644 index 0000000000..379ec80d91 --- /dev/null +++ b/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader_Icon.ico diff --git a/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/uIMDownloader.pas b/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/uIMDownloader.pas new file mode 100644 index 0000000000..168fc21a7f --- /dev/null +++ b/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/uIMDownloader.pas @@ -0,0 +1,612 @@ +{ ################################################################################### }
+{ # # }
+{ # IMDownloader # }
+{ # # }
+{ # Base on Downloader www.webdelphi.ru # }
+{ # http://www.webdelphi.ru/2009/10/mnogopotochnost-v-svoix-prilozheniyax-chast-2/ # }
+{ # # }
+{ # License: GPLv3 # }
+{ # # }
+{ # Author: Grigorev Michael (icq: 161867489, email: sleuthhound@gmail.com) # }
+{ # # }
+{ # Доработки по сравнению с Downloader: # }
+{ # + Добавлен работа через прокси (свойства Proxy, ProxyBypass, # }
+{ # AuthUserName, AuthPassword, ProxyAuthUserName, ProxyAuthPassword) # }
+{ # + Добавлено свойство DirPath - Путь где идет поиск файла и проверка его MD5. # }
+{ # (Имя файла и его MD5 узнаются из заголовка ответа сервера). Если MD5 файла # }
+{ # на диске равно MD5 файла в заголовке ответа, то скачивание не начинается. # }
+{ # + Событие OnHeaders - Получение заголовка ответа сервера. # }
+{ # + Событие OnMD5Checked - Подсчет MD5 суммы скаченного файла. # }
+{ # # }
+{ ################################################################################### }
+
+unit uIMDownloader;
+
+interface
+
+uses Classes, WinInet, SysUtils, Dialogs, Windows, Forms, uMD5;
+
+const
+ Accept = 'Accept: */*' + sLineBreak;
+ ProxyConnection = 'Proxy-Connection: Keep-Alive' + sLineBreak;
+ Lang = 'Accept-Language: ru' + sLineBreak;
+ Agent =
+ 'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; ' +
+ 'Windows NT 5.1; SV1; .NET CLR 2.0.50727)' + sLineBreak;
+
+type
+ PMemoryStream = ^TMemoryStream;
+ TIMDownloadError = (deInternetOpen, deInternetOpenUrl, deDownloadingFile, deConnect, deRequest);
+ TErrorEvent = procedure(Sender: TObject; E: TIMDownloadError) of object;
+ TDownloadingEvent = procedure(Sender: TObject; AcceptedSize, MaxSize: Cardinal) of object;
+ THeadersEvent = procedure(Sender: TObject; Headers: String) of object;
+ TMD5Event = procedure(Sender: TObject; MD5Correct, SizeCorrect: Boolean; MD5Str: String) of object;
+
+ TIMDownloadThread = class(TThread)
+ private
+ fURL: String;
+ fProxy: String;
+ fProxyBypass: String;
+ fAuthUserName: String;
+ fAuthPassword: String;
+ fProxyAuthUserName: String;
+ fProxyAuthPassword: String;
+ fDirPath: String;
+ MemoryStream: TMemoryStream;
+ Err: TIMDownloadError;
+ fError: TErrorEvent;
+ fAccepted: TNotifyEvent;
+ fBreak: TNotifyEvent;
+ fDownloading: TDownloadingEvent;
+ fHeaders: THeadersEvent;
+ AcceptedSize: Cardinal;
+ AllSize: Cardinal;
+ Headers: String;
+ MD5Str: String;
+ MD5Correct: Boolean;
+ SizeCorrect: Boolean;
+ fMD5: TMD5Event;
+ procedure toError;
+ procedure toHeaders;
+ procedure toDownloading;
+ procedure toAccepted;
+ procedure toBreak;
+ procedure toMD5;
+ procedure Complete;
+ function ErrorResult(E: Boolean; eType: TIMDownloadError): Boolean;
+ function GetQueryInfo(hRequest: Pointer; Flag: Integer): String;
+ protected
+ procedure Execute; override;
+ public
+ constructor Create(CreateSuspennded: Boolean; const URL, Proxy, ProxyBypass, AuthUserName, AuthPassword, ProxyAuthUserName, ProxyAuthPassword, DirPath: String; Stream: PMemoryStream);
+ property URL: string read fURL;
+ property Proxy: string read fProxy; // Список прокси
+ property ProxyBypass: string read fProxyBypass; // Дополниотельный список прокси
+ property AuthUserName: string read fAuthUserName; // Логин для Authorization: Basic
+ property AuthPassword: string read fAuthPassword; // Пароль для Authorization: Basic
+ property ProxyAuthUserName: string read fProxyAuthUserName; // Логин для прокси
+ property ProxyAuthPassword: string read fProxyAuthPassword; // Пароль для прокси
+ property DirPath: string read fDirPath write fDirPath; // Директория в которой будут проверяться MD5 файлов
+ property OnError: TErrorEvent read fError write fError;
+ property OnAccepted: TNotifyEvent read fAccepted write fAccepted;
+ property OnBreak: TNotifyEvent read fBreak write fBreak;
+ property OnDownloading: TDownloadingEvent read fDownloading write fDownloading;
+ property OnHeaders: THeadersEvent read fHeaders write fHeaders;
+ property OnMD5Checked: TMD5Event read fMD5 write fMD5;
+ end;
+
+ TIMDownloader = class(TComponent)
+ private
+ fOutStream: TMemoryStream;
+ fURL: String;
+ fProxy: String;
+ fProxyBypass: String;
+ fAuthUserName: String;
+ fAuthPassword: String;
+ fProxyAuthUserName: String;
+ fProxyAuthPassword: String;
+ fDirPath: String;
+ Downloader: TIMDownloadThread;
+ fOnError: TErrorEvent;
+ fOnAccepted: TNotifyEvent;
+ fOnBreak: TNotifyEvent;
+ fOnStartDownload: TNotifyEvent;
+ fInDowloading: Boolean;
+ fAcceptedSize: Cardinal;
+ fMyHeaders: String;
+ fMyMD5Str: String;
+ fMyMD5Correct: Boolean;
+ fMySizeCorrect: Boolean;
+ fHeaders: THeadersEvent;
+ fDownloading: TDownloadingEvent;
+ fMD5: TMD5Event;
+ procedure AcceptDownload(Sender: TObject);
+ procedure Break_Download(Sender: TObject);
+ procedure Downloading(Sender: TObject; AcceptedSize, MaxSize: Cardinal);
+ procedure GetHeaders(Sender: TObject; Headers: String);
+ procedure GetMD5(Sender: TObject; MD5Correct, SizeCorrect: Boolean; MD5Str: String);
+ procedure ErrorDownload(Sender: TObject; Error: TIMDownloadError);
+ public
+ procedure Download;
+ procedure BreakDownload;
+ property OutStream: TMemoryStream read fOutStream;
+ property InDowloading: Boolean read fInDowloading;
+ property AcceptedSize: Cardinal read fAcceptedSize;
+ property MyHeaders: String read fMyHeaders;
+ property MyMD5Str: String read fMyMD5Str;
+ property MyMD5Correct: Boolean read fMyMD5Correct;
+ property MySizeCorrect: Boolean read fMySizeCorrect;
+ published
+ property URL: string read fURL write fURL;
+ property Proxy: string read fProxy write fProxy; // Список прокси
+ property ProxyBypass: string read fProxyBypass write fProxyBypass; // Дополниотельный список прокси
+ property AuthUserName: string read fAuthUserName write fAuthUserName; // Логин для Authorization: Basic
+ property AuthPassword: string read fAuthPassword write fAuthPassword; // Пароль для Authorization: Basic
+ property ProxyAuthUserName: string read fProxyAuthUserName write fProxyAuthUserName; // Логин для прокси
+ property ProxyAuthPassword: string read fProxyAuthPassword write fProxyAuthUserName; // Пароль для прокси
+ property DirPath: string read fDirPath write fDirPath; // Директория в которой будут проверяться MD5 файлов
+ property OnError: TErrorEvent read fOnError write fOnError;
+ property OnAccepted: TNotifyEvent read fOnAccepted write fOnAccepted;
+ property OnHeaders: THeadersEvent read fHeaders write fHeaders;
+ property OnMD5Checked: TMD5Event read fMD5 write fMD5;
+ property OnDownloading: TDownloadingEvent read fDownloading write fDownloading;
+ property OnStartDownload: TNotifyEvent read fOnStartDownload write fOnStartDownload;
+ property OnBreak: TNotifyEvent read fOnBreak write fOnBreak;
+ end;
+
+{$R IMDownloader.dcr}
+
+procedure Register;
+
+implementation
+
+procedure Register;
+begin
+ RegisterComponents('IM-History', [TIMDownloader]);
+end;
+
+procedure TIMDownloadThread.toHeaders;
+begin
+ if Assigned(fHeaders) then
+ fHeaders(Self, Headers);
+end;
+
+procedure TIMDownloadThread.toMD5;
+begin
+ if Assigned(fMD5) then
+ fMD5(Self, MD5Correct, SizeCorrect, MD5Str);
+end;
+
+procedure TIMDownloadThread.toDownloading;
+begin
+ if Assigned(fDownloading) then
+ fDownloading(Self, AcceptedSize, AllSize);
+end;
+
+procedure TIMDownloadThread.toAccepted;
+begin
+ if Assigned(fAccepted) then
+ fAccepted(Self);
+end;
+
+procedure TIMDownloadThread.toBreak;
+begin
+ if Assigned(fBreak) then
+ fBreak(Self);
+end;
+
+procedure TIMDownloadThread.Complete;
+begin
+ if Terminated then
+ Synchronize(toBreak)
+ else
+ Synchronize(toAccepted);
+end;
+
+procedure TIMDownloadThread.toError;
+begin
+ if Assigned(fError) then
+ OnError(Self, err);
+end;
+
+function TIMDownloadThread.ErrorResult(E: Boolean; eType: TIMDownloadError): Boolean;
+begin
+ Result := E;
+ if E then
+ begin
+ err := eType;
+ toError;
+ end;
+end;
+
+function TIMDownloadThread.GetQueryInfo(hRequest: Pointer; Flag: Integer): String;
+var
+ Code: String;
+ Size, Index: Cardinal;
+begin
+ SetLength(Code, 8); // Достаточная длина для чтения статус-кода
+ Size := Length(Code);
+ Index := 0;
+ if HttpQueryInfo(hRequest, Flag ,PChar(Code), Size, Index) then
+ Result := Code
+ else
+ if GetLastError = ERROR_INSUFFICIENT_BUFFER then // Увеличиваем буффер
+ begin
+ SetLength(Code, Size);
+ Size := Length(Code);
+ if HttpQueryInfo(hRequest, Flag, PChar(Code), Size, Index) then
+ Result := Code;
+ end
+ else
+ begin
+ //FErrorCode := GetLastError;
+ Result := '';
+ end;
+end;
+
+procedure TIMDownloadThread.Execute;
+var
+ Buffer: Array [0 .. 1024] of Byte;
+ BytesRead: Cardinal;
+ FSession, FConnect, FRequest: hInternet;
+ dwBuffer: array [0 .. 1024] of Byte;
+ dwBufferLen, dwIndex: DWORD;
+ FHost, FScript, SRequest, ARequest: String;
+ ProxyReqRes, ProxyReqLen: Cardinal;
+ TempHeaders, TempMD5, DownloadsFileName, DownloadsFileMD5: String;
+
+ function DelHttp(sURL: String): String;
+ var
+ HttpPos: Integer;
+ begin
+ HttpPos := Pos('http://', sURL);
+ if HttpPos > 0 then Delete(sURL, HttpPos, 7);
+ Result := Copy(sURL, 1, Pos('/', sURL) - 1);
+ if Result = '' then Result := sURL;
+ end;
+
+ function ParseHeadersMD5andSize(HeaderStr: String): String;
+ var
+ HeadersStrList: TStringList;
+ I: Integer;
+ Size: String;
+ Ch: Char;
+ ResultFilename, ResultMD5Sum, ResultHeaders: String;
+ ResultFileSize: Integer;
+ begin
+ ResultFilename := 'Test';
+ ResultMD5Sum := '00000000000000000000000000000000';
+ ResultFileSize := 0;
+ // Создаем TStringList
+ HeadersStrList := TStringList.Create;
+ HeadersStrList.Clear;
+ HeadersStrList.Text := HeaderStr;
+ HeadersStrList.Delete(HeadersStrList.Count-1); // Последний элемент содержит всегда CRLF
+ if HeadersStrList.Count > 0 then
+ begin
+ for I := 0 to HeadersStrList.Count - 1 do
+ begin
+ // Парсим строку вида
+ // Content-Disposition: attachment; filename="ИМЯ-ФАЙЛА"
+ // Такую строку вставляет в заголовок HTTP-запроса
+ // только мой скрипт get.php
+ if pos('content-disposition', LowerCase(HeadersStrList[I])) > 0 then
+ begin
+ ResultFilename := HeadersStrList[I];
+ Delete(ResultFilename, 1, Pos('"', HeadersStrList[I]));
+ Delete(ResultFilename, Length(ResultFilename),1);
+ //LogMemo.Lines.Add('Filename: '+ResultFilename);
+ end;
+ // Парсим строку вида
+ // Content-MD5Sum: MD5
+ // Такую строку вставляет в заголовок HTTP-запроса
+ // только мой скрипт get.php
+ if pos('content-md5sum', LowerCase(HeadersStrList[I])) > 0 then
+ begin
+ ResultMD5Sum := HeadersStrList[I];
+ Delete(ResultMD5Sum, 1, Pos(':', HeadersStrList[I]));
+ Delete(ResultMD5Sum, 1,1);
+ end;
+ // Парсим строку вида
+ // Content-Length: РАЗМЕР
+ if pos('content-length', LowerCase(HeadersStrList[i])) > 0 then
+ begin
+ Size := '';
+ for Ch in HeadersStrList[I]do
+ if Ch in ['0'..'9'] then
+ Size := Size + Ch;
+ ResultFileSize := StrToIntDef(Size,-1);
+ end;
+ end;
+ Result := ResultFilename + '|' + LowerCase(ResultMD5Sum) + '|' + IntToStr(ResultFileSize) + '|';
+ end;
+ HeadersStrList.Free;
+ end;
+
+ { Функция разбивает строку S на слова, разделенные символами-разделителями,
+ указанными в строке Sep. Функция возвращает первое найденное слово, при
+ этом из строки S удаляется начальная часть до следующего слова }
+ function Tok(Sep: String; var S: String): String;
+
+ function isoneof(c, s: string): Boolean;
+ var
+ iTmp: integer;
+ begin
+ Result := False;
+ for iTmp := 1 to Length(s) do
+ begin
+ if c = Copy(s, iTmp, 1) then
+ begin
+ Result := True;
+ Exit;
+ end;
+ end;
+ end;
+
+ var
+ c, t: String;
+ begin
+ if s = '' then
+ begin
+ Result := s;
+ Exit;
+ end;
+ c := Copy(s, 1, 1);
+ while isoneof(c, sep) do
+ begin
+ s := Copy(s, 2, Length(s) - 1);
+ c := Copy(s, 1, 1);
+ end;
+ t := '';
+ while (not isoneof(c, sep)) and (s <> '') do
+ begin
+ t := t + c;
+ s := Copy(s, 2, length(s) - 1);
+ c := Copy(s, 1, 1);
+ end;
+ Result := t;
+ end;
+
+begin
+ // Инициализируем WinInet
+ if fProxy = '' then
+ FSession := InternetOpen('IM-History Download Master', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0)
+ else
+ begin
+ FSession := InternetOpen('IM-History Download Master', INTERNET_OPEN_TYPE_PROXY, PChar(fProxy), PChar(fProxyBypass), 0);
+ if fProxyAuthUserName <> '' then
+ begin
+ InternetSetOption(FSession, INTERNET_OPTION_PROXY_USERNAME, @fProxyAuthUserName, Length(fProxyAuthUserName));
+ InternetSetOption(FSession, INTERNET_OPTION_PROXY_PASSWORD, @fProxyAuthPassword, Length(fProxyAuthPassword));
+ end;
+ end;
+ if ErrorResult(FSession = nil, deInternetOpen) then
+ Exit;
+ if Assigned(FSession) then
+ begin
+ // Небольшой парсинг
+ // Вытаскиваем имя хоста и параметры обращения к скрипту
+ ARequest := fURL;
+ FHost := DelHttp(ARequest);
+ FScript := ARequest;
+ Delete(FScript, 1, Pos(FHost, FScript) + Length(FHost));
+ // Попытка соединения с сервером
+ if fAuthUserName = '' then // Если нет Basic-авторизации
+ FConnect := InternetOpenURL(FSession, PChar(fURL), nil, 0, INTERNET_FLAG_RELOAD, 0)
+ else
+ FConnect := InternetConnect(FSession, PChar(FHost), INTERNET_DEFAULT_HTTP_PORT, PChar(fAuthUserName),
+ PChar(fAuthPassword), INTERNET_SERVICE_HTTP, 0, 0);
+ if ErrorResult(FConnect = nil, deInternetOpenUrl) then
+ Exit;
+ dwIndex := 0;
+ dwBufferLen := Length(dwBuffer);
+ if fProxy <> '' then
+ begin
+ // Подготавливаем запрос
+ FRequest := HttpOpenRequest(FConnect, 'GET', PChar(FScript), nil, '', nil, 0, 0);
+ // Добавляем необходимые заголовки к запросу
+ HttpAddRequestHeaders(FRequest, Accept, Length(Accept), HTTP_ADDREQ_FLAG_ADD);
+ HttpAddRequestHeaders(FRequest, ProxyConnection, Length(ProxyConnection), HTTP_ADDREQ_FLAG_ADD);
+ HttpAddRequestHeaders(FRequest, Lang, Length(Lang), HTTP_ADDREQ_FLAG_ADD);
+ HttpAddRequestHeaders(FRequest, Agent, Length(Agent), HTTP_ADDREQ_FLAG_ADD);
+ // Проверяем запрос:
+ ProxyReqLen := 0;
+ ProxyReqRes := 0;
+ SRequest := ' ';
+ HttpQueryInfo(FRequest, HTTP_QUERY_RAW_HEADERS_CRLF or
+ HTTP_QUERY_FLAG_REQUEST_HEADERS, @SRequest[1], ProxyReqLen, ProxyReqRes);
+ if ProxyReqLen > 0 then
+ begin
+ SetLength(SRequest, ProxyReqLen);
+ HttpQueryInfo(FRequest, HTTP_QUERY_RAW_HEADERS_CRLF or
+ HTTP_QUERY_FLAG_REQUEST_HEADERS, @SRequest[1], ProxyReqLen, ProxyReqRes);
+ end;
+ // Отправляем запрос
+ if ErrorResult(not HttpSendRequest(FRequest, nil, 0, nil, 0), deRequest) then Exit;
+ end;
+ if fProxy = '' then
+ begin
+ // Получаем заголовок ответа с сервера
+ Headers := GetQueryInfo(FConnect, HTTP_QUERY_RAW_HEADERS_CRLF);
+ Synchronize(toHeaders);
+ // Запрос размера
+ if HttpQueryInfo(FConnect, HTTP_QUERY_CONTENT_LENGTH, @dwBuffer, dwBufferLen, dwIndex) then
+ AllSize := StrToInt('0' + PChar(@dwBuffer));
+ end
+ else
+ begin
+ // Получаем заголовок ответа с сервера
+ Headers := GetQueryInfo(FRequest, HTTP_QUERY_RAW_HEADERS_CRLF);
+ Synchronize(toHeaders);
+ // Запрос размера
+ if HttpQueryInfo(FRequest, HTTP_QUERY_CONTENT_LENGTH, @dwBuffer, dwBufferLen, dwIndex) then
+ AllSize := StrToInt('0' + PChar(@dwBuffer));
+ end;
+ // Проверяем MD5 старого файла на диске
+ TempHeaders := ParseHeadersMD5andSize(Headers);
+ DownloadsFileName := Tok('|', TempHeaders);
+ DownloadsFileMD5 := Tok('|', TempHeaders);
+ if FileExists(fDirPath+DownloadsFileName) then
+ TempMD5 := LowerCase(MD5DigestToStr(MD5File(fDirPath+DownloadsFileName)))
+ else
+ TempMD5 := '00000000000000000000000000000000';
+ if LowerCase(DownloadsFileMD5) <> TempMD5 then
+ begin
+ repeat
+ if Terminated then
+ Break;
+ FillChar(Buffer, SizeOf(Buffer), 0);
+ if fProxy = '' then
+ begin
+ if ErrorResult(not InternetReadFile(FConnect, @Buffer, Length(Buffer), BytesRead), deDownloadingFile) then
+ Exit
+ else
+ MemoryStream.Write(Buffer, BytesRead);
+ end
+ else
+ begin
+ if ErrorResult(not InternetReadFile(FRequest, @Buffer, Length(Buffer), BytesRead), deDownloadingFile) then
+ Exit
+ else
+ MemoryStream.Write(Buffer, BytesRead);
+ end;
+ AcceptedSize := MemoryStream.Size;
+ Synchronize(toDownloading);
+ until (BytesRead = 0);
+ MemoryStream.Position := 0;
+ // Подсчет MD5 и размера файла
+ MD5Str := LowerCase(MD5DigestToStr(MD5Stream(MemoryStream)));
+ TempHeaders := ParseHeadersMD5andSize(Headers);
+ DownloadsFileName := Tok('|', TempHeaders);
+ if Tok('|', TempHeaders) = MD5Str then
+ MD5Correct := True
+ else
+ MD5Correct := False;
+ if Tok('|', TempHeaders) = IntToStr(MemoryStream.Size) then
+ SizeCorrect := True
+ else
+ SizeCorrect := False;
+ Synchronize(toMD5);
+ end
+ else
+ begin
+ AcceptedSize := 0;
+ Synchronize(toDownloading);
+ MD5Str := 'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF';
+ MD5Correct := True;
+ SizeCorrect := True;
+ Synchronize(toMD5);
+ end;
+ // Очищаем ресурсы
+ if Assigned(FRequest) then
+ InternetCloseHandle(FRequest);
+ if Assigned(FConnect) then
+ InternetCloseHandle(FConnect);
+ InternetCloseHandle(FSession);
+ Pointer(MemoryStream) := nil;
+ Complete;
+ end;
+end;
+
+constructor TIMDownloadThread.Create(CreateSuspennded: Boolean; const URL, Proxy, ProxyBypass, AuthUserName, AuthPassword, ProxyAuthUserName, ProxyAuthPassword, DirPath: String; Stream: PMemoryStream);
+begin
+ inherited Create(CreateSuspennded);
+ FreeOnTerminate := True;
+ Pointer(MemoryStream) := Stream;
+ AcceptedSize := 0;
+ Headers := '';
+ MD5Str := '';
+ MD5Correct := False;
+ SizeCorrect := False;
+ fURL := URL;
+ fProxy := Proxy;
+ fProxyBypass := ProxyBypass;
+ fAuthUserName := AuthUserName;
+ fAuthPassword := AuthPassword;
+ fProxyAuthUserName := ProxyAuthUserName;
+ fProxyAuthPassword := ProxyAuthPassword;
+ fDirPath := DirPath;
+end;
+
+procedure TIMDownloader.Download;
+begin
+ fInDowloading := True;
+ if Assigned(Downloader) then
+ Downloader.Terminate;
+ if Assigned(fOutStream) then
+ FreeAndNil(fOutStream);
+ fAcceptedSize := 0;
+ fMyHeaders := '';
+ fMyMD5Str := '';
+ fMyMD5Correct := False;
+ fMySizeCorrect := False;
+ fOutStream := TMemoryStream.Create;
+ Downloader := TIMDownloadThread.Create(True, fURL, fProxy, fProxyBypass, fAuthUserName, fAuthPassword, fProxyAuthUserName, fProxyAuthPassword, fDirPath, Pointer(fOutStream));
+ Downloader.OnAccepted := AcceptDownload;
+ Downloader.OnError := ErrorDownload;
+ Downloader.OnHeaders := GetHeaders;
+ Downloader.OnDownloading := Downloading;
+ Downloader.OnBreak := Break_Download;
+ Downloader.OnMD5Checked := GetMD5;
+ Downloader.Resume;
+ if Assigned(fOnStartDownload) then
+ fOnStartDownload(Self);
+end;
+
+procedure TIMDownloader.BreakDownload;
+begin
+ if not InDowloading then
+ Exit;
+ if Assigned(Downloader) then
+ Downloader.Terminate;
+end;
+
+procedure TIMDownloader.Break_Download(Sender: TObject);
+begin
+ fInDowloading := False;
+ Downloader := nil;
+ if Assigned(fOnBreak) then
+ fOnBreak(Self);
+end;
+
+procedure TIMDownloader.AcceptDownload(Sender: TObject);
+begin
+ fInDowloading := False;
+ Downloader := nil;
+ if Assigned(fOnAccepted) then
+ fOnAccepted(Self);
+end;
+
+procedure TIMDownloader.GetHeaders(Sender: TObject; Headers: String);
+begin
+ fMyHeaders := Headers;
+ if Assigned(fHeaders) then
+ fHeaders(Self, Headers);
+end;
+
+procedure TIMDownloader.GetMD5(Sender: TObject; MD5Correct, SizeCorrect: Boolean; MD5Str: String);
+begin
+ fMyMD5Str := MD5Str;
+ fMyMD5Correct := MD5Correct;
+ fMySizeCorrect := SizeCorrect;
+ if Assigned(fMD5) then
+ fMD5(Self, MD5Correct, SizeCorrect, MD5Str);
+end;
+
+procedure TIMDownloader.Downloading(Sender: TObject; AcceptedSize, MaxSize: Cardinal);
+begin
+ fAcceptedSize := AcceptedSize;
+ if Assigned(fDownloading) then
+ fDownloading(Self, AcceptedSize, MaxSize);
+end;
+
+procedure TIMDownloader.ErrorDownload(Sender: TObject; Error: TIMDownloadError);
+begin
+ fInDowloading := False;
+ Downloader := nil;
+ fOutStream := nil;
+ if Assigned(fOnError) then
+ fOnError(Self, Error);
+end;
+
+end.
diff --git a/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/uMD5.pas b/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/uMD5.pas new file mode 100644 index 0000000000..81a6f4697b --- /dev/null +++ b/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/uMD5.pas @@ -0,0 +1,456 @@ +{******************************************************************}
+{ Вычисление хеш-суммы MD5 }
+{ }
+{ by delphibase.endimus.com }
+{ Зависимости: Windows, SysUtils, Classes }
+{ Автор: Dimka Maslov, mainbox@endimus.ru, ICQ:148442121, Санкт-Петербург }
+{ Copyright: http://www.faqs.org/rfcs/rfc1321.html }
+{ Дата: 19 июня 2002 г. }
+{******************************************************************}
+
+{******************************************************************}
+{ MD5 Hashsum Evaluation Unit For Borland Delphi }
+{ }
+{ Copyright © 2002 by Dimka Maslov }
+{ E-mail: mainbox@endimus.com, }
+{ Web-site: http://www.endimus.com }
+{ }
+{ Derived from the RSA Data Security, Inc. }
+{ MD5 Message-Digest Algorithm described in RFC 1321 }
+{ http://www.faqs.org/rfcs/rfc1321.html }
+{******************************************************************}
+
+unit uMD5;
+
+Interface
+
+Uses Windows, SysUtils, Classes;
+
+Type
+{ The TMD5Digest record is the type of results of
+ the MD5 hashsum evaluation functions. The contents
+ of a record may be used as four 32-bit integer values
+ or as an array of 16 bytes }
+{ Тип TMD5Digest используется для получения
+ результата функций вычисления хеш-суммы.
+ Содержимое записи можно использовать
+ как набор из 4 целых чисел, или как
+ массив из 16 байт }
+ PMD5Digest = ^TMD5Digest;
+
+ TMD5Digest = Record
+ Case Integer Of
+ 0: (A, B, C, D: LongInt);
+ 1: (v: Array[0..15] Of Byte);
+ End;
+
+{ The MD5String function evaluates the MD5 hashsum for
+ a string. The S parameter specifies a string to
+ evaluate hashsum }
+// вычисление хеш-суммы для строки
+Function MD5String(Const S: String): TMD5Digest;
+
+{ The MD5File function evaluates the MD5 hashsum for
+ a file. The FileName parameter specifies the name
+ of a file to evaluate hashsum }
+// вычисление хеш-суммы для файла
+Function MD5File(Const FileName: String): TMD5Digest;
+
+{ The MD5Stream function evaluates the MD5 hashsum for
+ a stream. The Stream parameters specifies the
+ TStream descendant class object to evaluate hashsum }
+// вычисление хеш-суммы для содержиого потока Stream
+Function MD5Stream(Const Stream: TStream): TMD5Digest;
+
+{ The MD5Buffer function evaluates the MD5 hashsum for
+ any memory buffer. The Buffer parameters specifies a
+ buffer to evaluate hashsum. The Size parameter specifies
+ the size (in bytes) of a buffer }
+// вычисление хеш-суммы для произвольного буфера
+Function MD5Buffer(Const Buffer; Size: Integer): TMD5Digest;
+
+{ The MD5DigestToStr function converts the result of
+ a hashsum evaluation function into a string of
+ hexadecimal digits }
+// преобразование хеш-суммы в строку из шестнадцатеричных цифр
+Function MD5DigestToStr(Const Digest: TMD5Digest): String;
+
+
+{ The MD5DigestCompare function compares two
+ TMD5Digest record variables. This function returns
+ TRUE if parameters are equal or FALSE otherwise }
+// сравнение двух хеш-сумм
+Function MD5DigestCompare(Const Digest1, Digest2: TMD5Digest): Boolean;
+
+{
+Copyright (C) 1991-2, RSA Data Security, Inc. Created 1991. All
+rights reserved.
+
+License to copy and use this software is granted provided that it
+is identified as the "RSA Data Security, Inc. MD5 Message-Digest
+Algorithm" in all material mentioning or referencing this software
+or this function.
+
+License is also granted to make and use derivative works provided
+that such works are identified as "derived from the RSA Data
+Security, Inc. MD5 Message-Digest Algorithm" in all material
+mentioning or referencing the derived work.
+
+RSA Data Security, Inc. makes no representations concerning either
+the merchantability of this software or the suitability of this
+software for any particular purpose. It is provided "as is"
+without express or implied warranty of any kind.
+
+These notices must be retained in any copies of any part of this
+documentation and/or software.
+}
+
+Implementation
+
+Type
+ UINT4 = LongWord;
+
+ PArray4UINT4 = ^TArray4UINT4;
+ TArray4UINT4 = Array[0..3] Of UINT4;
+ PArray2UINT4 = ^TArray2UINT4;
+ TArray2UINT4 = Array[0..1] Of UINT4;
+ PArray16Byte = ^TArray16Byte;
+ TArray16Byte = Array[0..15] Of Byte;
+ PArray64Byte = ^TArray64Byte;
+ TArray64Byte = Array[0..63] Of Byte;
+
+ PByteArray = ^TByteArray;
+ TByteArray = Array[0..0] Of Byte;
+
+ PUINT4Array = ^TUINT4Array;
+ TUINT4Array = Array[0..0] Of UINT4;
+
+ PMD5Context = ^TMD5Context;
+ TMD5Context = Record
+ state: TArray4UINT4;
+ count: TArray2UINT4;
+ buffer: TArray64Byte;
+ End;
+
+Const
+ S11 = 7;
+ S12 = 12;
+ S13 = 17;
+ S14 = 22;
+ S21 = 5;
+ S22 = 9;
+ S23 = 14;
+ S24 = 20;
+ S31 = 4;
+ S32 = 11;
+ S33 = 16;
+ S34 = 23;
+ S41 = 6;
+ S42 = 10;
+ S43 = 15;
+ S44 = 21;
+
+Var
+ Padding: TArray64Byte =
+ ($80, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
+
+
+Function _F(x, y, z: UINT4): UINT4;
+Begin
+ Result := (((x) And (y)) Or ((Not x) And (z)));
+End;
+
+Function _G(x, y, z: UINT4): UINT4;
+Begin
+ Result := (((x) And (z)) Or ((y) And (Not z)));
+End;
+
+Function _H(x, y, z: UINT4): UINT4;
+Begin
+ Result := ((x) Xor (y) Xor (z));
+End;
+
+Function _I(x, y, z: UINT4): UINT4;
+Begin
+ Result := ((y) Xor ((x) Or (Not z)));
+End;
+
+Function ROTATE_LEFT(x, n: UINT4): UINT4;
+Begin
+ Result := (((x) Shl (n)) Or ((x) Shr (32 - (n))));
+End;
+
+Procedure FF(Var a: UINT4; b, c, d, x, s, ac: UINT4);
+Begin
+ a := a + _F(b, c, d) + x + ac;
+ a := ROTATE_LEFT(a, s);
+ a := a + b;
+End;
+
+Procedure GG(Var a: UINT4; b, c, d, x, s, ac: UINT4);
+Begin
+ a := a + _G(b, c, d) + x + ac;
+ a := ROTATE_LEFT(a, s);
+ a := a + b;
+End;
+
+Procedure HH(Var a: UINT4; b, c, d, x, s, ac: UINT4);
+Begin
+ a := a + _H(b, c, d) + x + ac;
+ a := ROTATE_LEFT(a, s);
+ a := a + b;
+End;
+
+Procedure II(Var a: UINT4; b, c, d, x, s, ac: UINT4);
+Begin
+ a := a + _I(b, c, d) + x + ac;
+ a := ROTATE_LEFT(a, s);
+ a := a + b;
+End;
+
+Procedure MD5Encode(Output: PByteArray; Input: PUINT4Array; Len: LongWord);
+Var
+ i, j: LongWord;
+Begin
+ j := 0;
+ i := 0;
+ While j < Len Do Begin
+ output[j] := Byte(input[i] And $FF);
+ output[j + 1] := Byte((input[i] Shr 8) And $FF);
+ output[j + 2] := Byte((input[i] Shr 16) And $FF);
+ output[j + 3] := Byte((input[i] Shr 24) And $FF);
+ Inc(j, 4);
+ Inc(i);
+ End;
+End;
+
+Procedure MD5Decode(Output: PUINT4Array; Input: PByteArray; Len: LongWord);
+Var
+ i, j: LongWord;
+Begin
+ j := 0;
+ i := 0;
+ While j < Len Do Begin
+ Output[i] := UINT4(input[j]) Or (UINT4(input[j + 1]) Shl 8) Or
+ (UINT4(input[j + 2]) Shl 16) Or (UINT4(input[j + 3]) Shl 24);
+ Inc(j, 4);
+ Inc(i);
+ End;
+End;
+
+Procedure MD5_memcpy(Output: PByteArray; Input: PByteArray; Len: LongWord);
+Begin
+ Move(Input^, Output^, Len);
+End;
+
+Procedure MD5_memset(Output: PByteArray; Value: Integer; Len: LongWord);
+Begin
+ FillChar(Output^, Len, Byte(Value));
+End;
+
+Procedure MD5Transform(State: PArray4UINT4; Buffer: PArray64Byte);
+Var
+ a, b, c, d: UINT4;
+ x: Array[0..15] Of UINT4;
+Begin
+ a := State[0]; b := State[1]; c := State[2]; d := State[3];
+ MD5Decode(PUINT4Array(@x), PByteArray(Buffer), 64);
+
+ FF(a, b, c, d, x[0], S11, $D76AA478);
+ FF(d, a, b, c, x[1], S12, $E8C7B756);
+ FF(c, d, a, b, x[2], S13, $242070DB);
+ FF(b, c, d, a, x[3], S14, $C1BDCEEE);
+ FF(a, b, c, d, x[4], S11, $F57C0FAF);
+ FF(d, a, b, c, x[5], S12, $4787C62A);
+ FF(c, d, a, b, x[6], S13, $A8304613);
+ FF(b, c, d, a, x[7], S14, $FD469501);
+ FF(a, b, c, d, x[8], S11, $698098D8);
+ FF(d, a, b, c, x[9], S12, $8B44F7AF);
+ FF(c, d, a, b, x[10], S13, $FFFF5BB1);
+ FF(b, c, d, a, x[11], S14, $895CD7BE);
+ FF(a, b, c, d, x[12], S11, $6B901122);
+ FF(d, a, b, c, x[13], S12, $FD987193);
+ FF(c, d, a, b, x[14], S13, $A679438E);
+ FF(b, c, d, a, x[15], S14, $49B40821);
+
+ GG(a, b, c, d, x[1], S21, $F61E2562);
+ GG(d, a, b, c, x[6], S22, $C040B340);
+ GG(c, d, a, b, x[11], S23, $265E5A51);
+ GG(b, c, d, a, x[0], S24, $E9B6C7AA);
+ GG(a, b, c, d, x[5], S21, $D62F105D);
+ GG(d, a, b, c, x[10], S22, $2441453);
+ GG(c, d, a, b, x[15], S23, $D8A1E681);
+ GG(b, c, d, a, x[4], S24, $E7D3FBC8);
+ GG(a, b, c, d, x[9], S21, $21E1CDE6);
+ GG(d, a, b, c, x[14], S22, $C33707D6);
+ GG(c, d, a, b, x[3], S23, $F4D50D87);
+
+ GG(b, c, d, a, x[8], S24, $455A14ED);
+ GG(a, b, c, d, x[13], S21, $A9E3E905);
+ GG(d, a, b, c, x[2], S22, $FCEFA3F8);
+ GG(c, d, a, b, x[7], S23, $676F02D9);
+ GG(b, c, d, a, x[12], S24, $8D2A4C8A);
+
+ HH(a, b, c, d, x[5], S31, $FFFA3942);
+ HH(d, a, b, c, x[8], S32, $8771F681);
+ HH(c, d, a, b, x[11], S33, $6D9D6122);
+ HH(b, c, d, a, x[14], S34, $FDE5380C);
+ HH(a, b, c, d, x[1], S31, $A4BEEA44);
+ HH(d, a, b, c, x[4], S32, $4BDECFA9);
+ HH(c, d, a, b, x[7], S33, $F6BB4B60);
+ HH(b, c, d, a, x[10], S34, $BEBFBC70);
+ HH(a, b, c, d, x[13], S31, $289B7EC6);
+ HH(d, a, b, c, x[0], S32, $EAA127FA);
+ HH(c, d, a, b, x[3], S33, $D4EF3085);
+ HH(b, c, d, a, x[6], S34, $4881D05);
+ HH(a, b, c, d, x[9], S31, $D9D4D039);
+ HH(d, a, b, c, x[12], S32, $E6DB99E5);
+ HH(c, d, a, b, x[15], S33, $1FA27CF8);
+ HH(b, c, d, a, x[2], S34, $C4AC5665);
+
+ II(a, b, c, d, x[0], S41, $F4292244);
+ II(d, a, b, c, x[7], S42, $432AFF97);
+ II(c, d, a, b, x[14], S43, $AB9423A7);
+ II(b, c, d, a, x[5], S44, $FC93A039);
+ II(a, b, c, d, x[12], S41, $655B59C3);
+ II(d, a, b, c, x[3], S42, $8F0CCC92);
+ II(c, d, a, b, x[10], S43, $FFEFF47D);
+ II(b, c, d, a, x[1], S44, $85845DD1);
+ II(a, b, c, d, x[8], S41, $6FA87E4F);
+ II(d, a, b, c, x[15], S42, $FE2CE6E0);
+ II(c, d, a, b, x[6], S43, $A3014314);
+ II(b, c, d, a, x[13], S44, $4E0811A1);
+ II(a, b, c, d, x[4], S41, $F7537E82);
+ II(d, a, b, c, x[11], S42, $BD3AF235);
+ II(c, d, a, b, x[2], S43, $2AD7D2BB);
+ II(b, c, d, a, x[9], S44, $EB86D391);
+
+ Inc(State[0], a);
+ Inc(State[1], b);
+ Inc(State[2], c);
+ Inc(State[3], d);
+
+ MD5_memset(PByteArray(@x), 0, SizeOf(x));
+End;
+
+
+Procedure MD5Init(Var Context: TMD5Context);
+Begin
+ FillChar(Context, SizeOf(Context), 0);
+ Context.state[0] := $67452301;
+ Context.state[1] := $EFCDAB89;
+ Context.state[2] := $98BADCFE;
+ Context.state[3] := $10325476;
+End;
+
+Procedure MD5Update(Var Context: TMD5Context; Input: PByteArray; InputLen: LongWord);
+Var
+ i, index, partLen: LongWord;
+
+Begin
+ index := LongWord((context.count[0] Shr 3) And $3F);
+ Inc(Context.count[0], UINT4(InputLen) Shl 3);
+ If Context.count[0] < UINT4(InputLen) Shl 3 Then Inc(Context.count[1]);
+ Inc(Context.count[1], UINT4(InputLen) Shr 29);
+ partLen := 64 - index;
+ If inputLen >= partLen Then Begin
+ MD5_memcpy(PByteArray(@Context.buffer[index]), Input, PartLen);
+ MD5Transform(@Context.state, @Context.buffer);
+ i := partLen;
+ While i + 63 < inputLen Do Begin
+ MD5Transform(@Context.state, PArray64Byte(@Input[i]));
+ Inc(i, 64);
+ End;
+ index := 0;
+ End Else i := 0;
+ MD5_memcpy(PByteArray(@Context.buffer[index]), PByteArray(@Input[i]), inputLen - i);
+End;
+
+
+Procedure MD5Final(Var Digest: TMD5Digest; Var Context: TMD5Context);
+Var
+ bits: Array[0..7] Of Byte;
+ index, padLen: LongWord;
+Begin
+ MD5Encode(PByteArray(@bits), PUINT4Array(@Context.count), 8);
+ index := LongWord((Context.count[0] Shr 3) And $3F);
+ If index < 56 Then padLen := 56 - index Else padLen := 120 - index;
+ MD5Update(Context, PByteArray(@PADDING), padLen);
+ MD5Update(Context, PByteArray(@Bits), 8);
+ MD5Encode(PByteArray(@Digest), PUINT4Array(@Context.state), 16);
+ MD5_memset(PByteArray(@Context), 0, SizeOf(Context));
+End;
+
+Function MD5DigestToStr(Const Digest: TMD5Digest): String;
+Var
+ i: Integer;
+Begin
+ Result := '';
+ For i := 0 To 15 Do Result := Result + IntToHex(Digest.v[i], 2);
+End;
+
+Function MD5String(Const S: String): TMD5Digest;
+Begin
+ Result := MD5Buffer(PChar(S)^, Length(S));
+End;
+
+Function MD5File(Const FileName: String): TMD5Digest;
+Var
+ F: TFileStream;
+Begin
+ F := TFileStream.Create(FileName, fmOpenRead);
+ Try
+ Result := MD5Stream(F);
+ Finally
+ F.Free;
+ End;
+End;
+
+Function MD5Stream(Const Stream: TStream): TMD5Digest;
+Var
+ Context: TMD5Context;
+ Buffer: Array[0..4095] Of Byte;
+ Size: Integer;
+ ReadBytes: Integer;
+ TotalBytes: Integer;
+ SavePos: Integer;
+Begin
+ MD5Init(Context);
+ Size := Stream.Size;
+ SavePos := Stream.Position;
+ TotalBytes := 0;
+ Try
+ Stream.Seek(0, soFromBeginning);
+ Repeat
+ ReadBytes := Stream.Read(Buffer, SizeOf(Buffer));
+ Inc(TotalBytes, ReadBytes);
+ MD5Update(Context, @Buffer, ReadBytes);
+ Until (ReadBytes = 0) Or (TotalBytes = Size);
+ Finally
+ Stream.Seek(SavePos, soFromBeginning);
+ End;
+ MD5Final(Result, Context);
+End;
+
+Function MD5Buffer(Const Buffer; Size: Integer): TMD5Digest;
+Var
+ Context: TMD5Context;
+Begin
+ MD5Init(Context);
+ MD5Update(Context, PByteArray(@Buffer), Size);
+ MD5Final(Result, Context);
+End;
+
+Function MD5DigestCompare(Const Digest1, Digest2: TMD5Digest): Boolean;
+Begin
+ Result := False;
+ If Digest1.A <> Digest2.A Then Exit;
+ If Digest1.B <> Digest2.B Then Exit;
+ If Digest1.C <> Digest2.C Then Exit;
+ If Digest1.D <> Digest2.D Then Exit;
+ Result := True;
+End;
+
+End.
|