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 5280 -> 0 bytes .../Demo/DownLoaderTestUnit.dfm | 125 ----- .../Demo/DownLoaderTestUnit.pas | 176 ------ .../IMDownloaderComponent/IMDownloader.dcr | Bin 1728 -> 0 bytes .../IMDownloaderComponent/IMDownloader.dpk | 38 -- .../IMDownloaderComponent/IMDownloader.dproj | 168 ------ .../IMDownloaderComponent/IMDownloader.res | Bin 5560 -> 0 bytes .../IMDownloaderComponent/IMDownloader_Icon.ico | Bin 4286 -> 0 bytes .../IMDownloaderComponent/uIMDownloader.pas | 612 --------------------- .../IMDownloaderComponent/uMD5.pas | 456 --------------- 12 files changed, 1699 deletions(-) delete mode 100644 plugins/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTest.dpr delete mode 100644 plugins/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTest.dproj delete mode 100644 plugins/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTest.res delete mode 100644 plugins/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTestUnit.dfm delete mode 100644 plugins/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTestUnit.pas delete mode 100644 plugins/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader.dcr delete mode 100644 plugins/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader.dpk delete mode 100644 plugins/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader.dproj delete mode 100644 plugins/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader.res delete mode 100644 plugins/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader_Icon.ico delete mode 100644 plugins/MirandaNGHistoryToDB/IMDownloaderComponent/uIMDownloader.pas delete mode 100644 plugins/MirandaNGHistoryToDB/IMDownloaderComponent/uMD5.pas (limited to 'plugins/MirandaNGHistoryToDB/IMDownloaderComponent') diff --git a/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTest.dpr b/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTest.dpr deleted file mode 100644 index 8942f8b61d..0000000000 --- a/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTest.dpr +++ /dev/null @@ -1,15 +0,0 @@ -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 deleted file mode 100644 index c0b14483c0..0000000000 --- a/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTest.dproj +++ /dev/null @@ -1,109 +0,0 @@ -п»ї - - {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/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTest.res b/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTest.res deleted file mode 100644 index fc1937e1c7..0000000000 Binary files a/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTest.res and /dev/null differ diff --git a/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTestUnit.dfm b/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTestUnit.dfm deleted file mode 100644 index b245bf8704..0000000000 --- a/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTestUnit.dfm +++ /dev/null @@ -1,125 +0,0 @@ -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 deleted file mode 100644 index 2ca42ac174..0000000000 --- a/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/Demo/DownLoaderTestUnit.pas +++ /dev/null @@ -1,176 +0,0 @@ -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 deleted file mode 100644 index 2311dc0fef..0000000000 Binary files a/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader.dcr and /dev/null differ diff --git a/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader.dpk b/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader.dpk deleted file mode 100644 index f925b6df62..0000000000 --- a/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader.dpk +++ /dev/null @@ -1,38 +0,0 @@ -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 deleted file mode 100644 index 092d815fc7..0000000000 --- a/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader.dproj +++ /dev/null @@ -1,168 +0,0 @@ -п»ї - - {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/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader.res b/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader.res deleted file mode 100644 index ebc501849a..0000000000 Binary files a/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader.res and /dev/null differ diff --git a/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader_Icon.ico b/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader_Icon.ico deleted file mode 100644 index 379ec80d91..0000000000 Binary files a/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/IMDownloader_Icon.ico and /dev/null differ diff --git a/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/uIMDownloader.pas b/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/uIMDownloader.pas deleted file mode 100644 index 168fc21a7f..0000000000 --- a/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/uIMDownloader.pas +++ /dev/null @@ -1,612 +0,0 @@ -{ ################################################################################### } -{ # # } -{ # 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 deleted file mode 100644 index 81a6f4697b..0000000000 --- a/plugins/MirandaNGHistoryToDB/IMDownloaderComponent/uMD5.pas +++ /dev/null @@ -1,456 +0,0 @@ -{******************************************************************} -{ Вычисление хеш-суммы 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