From 9649ae46f093f7d4e6130d24c90da19e153a2ccf Mon Sep 17 00:00:00 2001 From: Vadim Dashevskiy Date: Tue, 10 Dec 2013 14:30:49 +0000 Subject: MirandaNGHistoryToDB moved to deprecated git-svn-id: http://svn.miranda-ng.org/main/trunk@7118 1316c22d-e87f-b044-9b9b-93d7a3e3ba9c --- .../IMDownloaderComponent/Demo/DownLoaderTest.dpr | 15 + .../Demo/DownLoaderTest.dproj | 109 ++++ .../IMDownloaderComponent/Demo/DownLoaderTest.res | Bin 0 -> 5280 bytes .../Demo/DownLoaderTestUnit.dfm | 125 +++++ .../Demo/DownLoaderTestUnit.pas | 176 ++++++ .../IMDownloaderComponent/IMDownloader.dcr | Bin 0 -> 1728 bytes .../IMDownloaderComponent/IMDownloader.dpk | 38 ++ .../IMDownloaderComponent/IMDownloader.dproj | 168 ++++++ .../IMDownloaderComponent/IMDownloader.res | Bin 0 -> 5560 bytes .../IMDownloaderComponent/IMDownloader_Icon.ico | Bin 0 -> 4286 bytes .../IMDownloaderComponent/uIMDownloader.pas | 612 +++++++++++++++++++++ .../IMDownloaderComponent/uMD5.pas | 456 +++++++++++++++ 12 files changed, 1699 insertions(+) create mode 100644 plugins/!Deprecated/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTest.dpr create mode 100644 plugins/!Deprecated/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTest.dproj create mode 100644 plugins/!Deprecated/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTest.res create mode 100644 plugins/!Deprecated/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTestUnit.dfm create mode 100644 plugins/!Deprecated/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTestUnit.pas create mode 100644 plugins/!Deprecated/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader.dcr create mode 100644 plugins/!Deprecated/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader.dpk create mode 100644 plugins/!Deprecated/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader.dproj create mode 100644 plugins/!Deprecated/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader.res create mode 100644 plugins/!Deprecated/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader_Icon.ico create mode 100644 plugins/!Deprecated/MirandaNGHistoryToDB/IMDownloaderComponent/uIMDownloader.pas create mode 100644 plugins/!Deprecated/MirandaNGHistoryToDB/IMDownloaderComponent/uMD5.pas (limited to 'plugins/!Deprecated/MirandaNGHistoryToDB/IMDownloaderComponent') diff --git a/plugins/!Deprecated/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTest.dpr b/plugins/!Deprecated/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTest.dpr new file mode 100644 index 0000000000..8942f8b61d --- /dev/null +++ b/plugins/!Deprecated/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/!Deprecated/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTest.dproj b/plugins/!Deprecated/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTest.dproj new file mode 100644 index 0000000000..c0b14483c0 --- /dev/null +++ b/plugins/!Deprecated/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTest.dproj @@ -0,0 +1,109 @@ +п»ї + + {8B841E47-C817-4F26-8ACF-89048F0E7C42} + DownLoaderTest.dpr + True + Release + Win32 + Application + VCL + DCC32 + 12.3 + + + true + + + true + Base + true + + + true + Base + true + + + 00400000 + false + false + false + false + false + WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;WinTypes=Windows;WinProcs=Windows;$(DCC_UnitAlias) + + + 0 + RELEASE;$(DCC_Define) + false + false + + + DEBUG;$(DCC_Define) + true + false + + + + MainSource + + +
MainForm
+ + + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + + + + + + Delphi.Personality.12 + VCLApplication + + + + DownLoaderTest.dpr + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 1049 + 1251 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + + + True + + + 12 + + diff --git a/plugins/!Deprecated/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTest.res b/plugins/!Deprecated/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTest.res new file mode 100644 index 0000000000..fc1937e1c7 Binary files /dev/null and b/plugins/!Deprecated/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTest.res differ diff --git a/plugins/!Deprecated/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTestUnit.dfm b/plugins/!Deprecated/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTestUnit.dfm new file mode 100644 index 0000000000..b245bf8704 --- /dev/null +++ b/plugins/!Deprecated/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/!Deprecated/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTestUnit.pas b/plugins/!Deprecated/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTestUnit.pas new file mode 100644 index 0000000000..2ca42ac174 --- /dev/null +++ b/plugins/!Deprecated/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/!Deprecated/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader.dcr b/plugins/!Deprecated/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader.dcr new file mode 100644 index 0000000000..2311dc0fef Binary files /dev/null and b/plugins/!Deprecated/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader.dcr differ diff --git a/plugins/!Deprecated/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader.dpk b/plugins/!Deprecated/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader.dpk new file mode 100644 index 0000000000..f925b6df62 --- /dev/null +++ b/plugins/!Deprecated/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/!Deprecated/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader.dproj b/plugins/!Deprecated/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader.dproj new file mode 100644 index 0000000000..092d815fc7 --- /dev/null +++ b/plugins/!Deprecated/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader.dproj @@ -0,0 +1,168 @@ +п»ї + + {BF7E5A55-CA0C-4DDD-B399-17FA1A2FF83F} + IMDownloader.dpk + True + Release + Package + VCL + DCC32 + 14.3 + Win32 + 3 + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace) + 4 + 1049 + CompanyName=;FileDescription=;FileVersion=1.0.0.4;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= + false + false + RELEASE;$(DCC_Define) + 00400000 + true + false + false + 0 + false + true + false + false + + + true + IMDownloader_Icon.ico + System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + 1033 + vcl;rtl;$(DCC_UsePackage) + $(BDS)\bin\default_app.manifest + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= + + + 1033 + IMDownloader_Icon.ico + System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + vcl;rtl;$(DCC_UsePackage) + $(BDS)\bin\default_app.manifest + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= + + + 1033 + 0 + .\$(Platform)\$(Config) + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= + + + 1033 + 0 + .\$(Platform)\$(Config) + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= + + + DEBUG;$(DCC_Define) + true + false + + + + MainSource + + + + + + + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + + + + + + Delphi.Personality.12 + Package + + + + IMDownloader.dpk + + + True + False + 1 + 0 + 0 + 4 + False + False + False + False + False + 1049 + 1251 + + + + + 1.0.0.4 + + + + + + 1.0.0.0 + + + + + + True + True + + + 12 + + diff --git a/plugins/!Deprecated/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader.res b/plugins/!Deprecated/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader.res new file mode 100644 index 0000000000..ebc501849a Binary files /dev/null and b/plugins/!Deprecated/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader.res differ diff --git a/plugins/!Deprecated/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader_Icon.ico b/plugins/!Deprecated/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader_Icon.ico new file mode 100644 index 0000000000..379ec80d91 Binary files /dev/null and b/plugins/!Deprecated/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader_Icon.ico differ diff --git a/plugins/!Deprecated/MirandaNGHistoryToDB/IMDownloaderComponent/uIMDownloader.pas b/plugins/!Deprecated/MirandaNGHistoryToDB/IMDownloaderComponent/uIMDownloader.pas new file mode 100644 index 0000000000..168fc21a7f --- /dev/null +++ b/plugins/!Deprecated/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/!Deprecated/MirandaNGHistoryToDB/IMDownloaderComponent/uMD5.pas b/plugins/!Deprecated/MirandaNGHistoryToDB/IMDownloaderComponent/uMD5.pas new file mode 100644 index 0000000000..81a6f4697b --- /dev/null +++ b/plugins/!Deprecated/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. -- cgit v1.2.3