-object Form1: TForm1
- Left = 345
- Top = 125
- Width = 1305
- Height = 675
- Caption = 'Form1'
+object MainForm: TMainForm
+ Left = 608
+ Top = 189
+ Width = 872
+ Height = 271
+ Caption = 'MHashDelphi384 - Example App'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
+ Position = poScreenCenter
+ OnCloseQuery = FormCloseQuery
OnCreate = FormCreate
+ DesignSize = (
+ 856
+ 232)
PixelsPerInch = 96
TextHeight = 13
- object Button1: TButton
+ object Label1: TLabel
Left = 8
Top = 8
- Width = 75
+ Width = 58
+ Height = 13
+ Caption = 'Input File:'
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'MS Sans Serif'
+ Font.Style = [fsBold]
+ ParentFont = False
+ end
+ object Label2: TLabel
+ Left = 8
+ Top = 64
+ Width = 65
+ Height = 13
+ Caption = 'File Digest:'
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'MS Sans Serif'
+ Font.Style = [fsBold]
+ ParentFont = False
+ end
+ object Button_Compute: TButton
+ Left = 711
+ Top = 183
+ Width = 123
Height = 25
- Caption = 'Button1'
+ Anchors = [akRight, akBottom]
+ Caption = 'Compute Hash'
+ TabOrder = 1
+ OnClick = Button_ComputeClick
+ end
+ object Edit_InputFile: TEdit
+ Left = 8
+ Top = 24
+ Width = 825
+ Height = 21
+ Anchors = [akLeft, akTop, akRight]
+ ReadOnly = True
+ TabOrder = 2
+ end
+ object Edit_FileDigest: TEdit
+ Left = 8
+ Top = 80
+ Width = 825
+ Height = 22
+ Anchors = [akLeft, akTop, akRight]
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'Courier New'
+ Font.Style = []
+ ParentFont = False
+ ReadOnly = True
+ TabOrder = 3
+ end
+ object Button_Browse: TButton
+ Left = 575
+ Top = 183
+ Width = 121
+ Height = 25
+ Anchors = [akRight, akBottom]
+ Caption = 'Browse File'
TabOrder = 0
- OnClick = Button1Click
+ OnClick = Button_BrowseClick
+ end
+ object ProgressBar: TProgressBar
+ Left = 8
+ Top = 128
+ Width = 825
+ Height = 17
+ Anchors = [akLeft, akTop, akRight]
+ Smooth = True
+ TabOrder = 4
+ end
+ object OpenDialog: TOpenDialog
+ Left = 8
+ Top = 168
end
end
unit Main;
+{===========================================================================}
+{ INTERFACE }
+{===========================================================================}
+
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, MHash384, StdCtrls;
+ Dialogs, MHash384, StdCtrls, ComCtrls;
type
- TForm1 = class(TForm)
- Button1: TButton;
- procedure Button1Click(Sender: TObject);
+ TMainForm = class(TForm)
+ Button_Compute: TButton;
+ Edit_InputFile: TEdit;
+ Label1: TLabel;
+ Label2: TLabel;
+ Edit_FileDigest: TEdit;
+ Button_Browse: TButton;
+ ProgressBar: TProgressBar;
+ OpenDialog: TOpenDialog;
procedure FormCreate(Sender: TObject);
+ procedure Button_BrowseClick(Sender: TObject);
+ procedure Button_ComputeClick(Sender: TObject);
+ procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
+ protected
+ procedure ThreadTerminated(Sender: TObject);
+ procedure ProgressChanged(progress: Integer);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
+type
+ TProgressEvent = procedure(progress: Integer) of object;
+
+type
+ TComputeThread = class(TThread)
+ private
+ hwnd: HWND;
+ inputFile, hashString: String;
+ progressValue: Integer;
+ progressEvent: TProgressEvent;
+ public
+ constructor Create(const hwnd: HWND; const inputFile: String);
+ function GetResult: String;
+ property OnProgress: TProgressEvent read progressEvent write progressEvent;
+ protected
+ procedure Execute(); override;
+ function FileSize64(const fileName: string): UInt64;
+ procedure SetProgress(const processed: UInt64; const totalSize: UInt64);
+ function ByteToHex(input: TByteArray):String;
+ procedure UpdateProgress;
+ end;
+
var
- Form1: TForm1;
+ MainForm: TMainForm;
+
+{===========================================================================}
+{ IMPLEMENTATION }
+{===========================================================================}
implementation
{$R *.dfm}
-procedure TForm1.Button1Click(Sender: TObject);
-var
- mhash: TMHash384;
-begin
- mhash := TMHash384.Create();
-end;
+{----------------------------------------------}
+{ Main Form }
+{----------------------------------------------}
-procedure TForm1.FormCreate(Sender: TObject);
+procedure TMainForm.FormCreate(Sender: TObject);
var
Version: TMHash384Ver;
begin
+ Constraints.MinHeight := Height;
+ Constraints.MinWidth := Width;
FillChar(Version, SizeOf(TMHash384Ver), #0);
TMHash384.GetVer(Version);
Caption := 'MHashDelphi384 - Example App v' + Format('%d.%d.%d', [Version.Major, Version.Minor, Version.Patch]);
end;
+procedure TMainForm.Button_BrowseClick(Sender: TObject);
+begin
+ if OpenDialog.Execute then
+ begin
+ Edit_FileDigest.Text := '';
+ Edit_InputFile.Text := OpenDialog.FileName;
+ ProgressBar.Position := 0;
+ end;
+end;
+
+procedure TMainForm.Button_ComputeClick(Sender: TObject);
+var
+ thread: TComputeThread;
+begin
+ Button_Browse.Enabled := False;
+ Button_Compute.Enabled := False;
+ ProgressBar.Position := 0;
+ Edit_FileDigest.Text := 'Working, please wait...';
+
+ thread := TComputeThread.Create(Self.WindowHandle, Edit_InputFile.Text);
+ thread.OnProgress := ProgressChanged;
+ thread.OnTerminate := ThreadTerminated;
+ thread.Resume;
+end;
+
+procedure TMainForm.ProgressChanged(progress: Integer);
+begin
+ ProgressBar.Position := progress;
+end;
+
+procedure TMainForm.ThreadTerminated(Sender: TObject);
+begin
+ if Sender is TComputeThread then
+ begin
+ Edit_FileDigest.Text := (Sender as TComputeThread).GetResult();
+ Button_Compute.Enabled := True;
+ Button_Browse.Enabled := True;
+ end;
+end;
+
+procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
+begin
+ CanClose := Button_Compute.Enabled and Button_Browse.Enabled;
+end;
+
+{----------------------------------------------}
+{ Compute Thread }
+{----------------------------------------------}
+
+constructor TComputeThread.Create(const hwnd: HWND; const inputFile: String);
+begin
+ inherited Create(True);
+ Self.hwnd := hwnd;
+ Self.inputFile := inputFile;
+ ReturnValue := 0;
+ progressEvent := nil;
+end;
+
+function TComputeThread.GetResult: String;
+var
+ exitCode: Cardinal;
+begin
+ Result := hashString;
+end;
+
+procedure TComputeThread.Execute();
+var
+ digest: TMHash384;
+ inputFile: File;
+ buffer, result: TByteArray;
+ count, spinner: Integer;
+ totalSize, processed: UInt64;
+begin
+ inherited;
+ try
+ ReturnValue := 0;
+ processed := 0;
+ spinner := 0;
+
+ SetLength(buffer, 4096);
+ SetProgress(0, 100);
+ totalSize := FileSize64(Self.inputFile);
+
+ AssignFile(inputFile, Self.inputFile);
+ FileMode := fmOpenRead;
+ Reset(inputFile, 1);
+
+ try
+ digest := TMHash384.Create();
+ while not Eof(inputFile) do
+ begin
+ BlockRead(inputFile, buffer[0], Length(buffer), count);
+ if count > 0 then
+ begin
+ digest.Update(buffer, 0, count);
+ spinner := spinner + 1;
+ processed := processed + count;
+ if spinner >= 100 then
+ begin
+ SetProgress(processed, totalSize);
+ spinner := 0;
+ end;
+ end;
+ end;
+ digest.Result(result);
+ HashString := ByteToHex(result);
+ ReturnValue := 1;
+ finally
+ CloseFile(inputFile);
+ digest.Destroy();
+ SetProgress(100, 100);
+ end;
+ except
+ on E: Exception do
+ begin
+ MessageBox(self.hwnd, PAnsiChar('Failed to open input file!'#10#10'Details:'#10 + E.Message), PAnsiChar(String(E.ClassName)), MB_ICONERROR or MB_SYSTEMMODAL);
+ Exit;
+ end;
+ end;
+end;
+
+function TComputeThread.FileSize64(const fileName: string): UInt64;
+var
+ F: TSearchRec;
+begin
+ Result := 0;
+ if FindFirst(fileName, faAnyFile, F) = 0 then
+ begin
+ try
+ Result := UInt64(F.FindData.nFileSizeLow) or (UInt64(F.FindData.nFileSizeHigh) shl 32);
+ finally
+ FindClose(F);
+ end;
+ end;
+end;
+
+procedure TComputeThread.UpdateProgress;
+begin
+ if Assigned(progressEvent) then
+ begin
+ progressEvent(progressValue);
+ end;
+end;
+
+
+procedure TComputeThread.SetProgress(const processed: UInt64; const totalSize: UInt64);
+var
+ nextProgress: Integer;
+ totalSizeDbl, processedDbl: Double;
+begin
+ if (processed > 0) and (totalSize > 0) then
+ begin
+ totalSizeDbl := totalSize;
+ processedDbl := processed;
+ nextProgress := Round((processedDbl / totalSizeDbl) * 100.0);
+ end else
+ begin
+ progressValue := 0;
+ end;
+
+ if nextProgress <> progressValue then
+ begin
+ progressValue := nextProgress;
+ Synchronize(updateProgress);
+ end;
+end;
+
+function TComputeThread.ByteToHex(input: TByteArray):String;
+const
+ digits:array[0..15] of char='0123456789ABCDEF';
+var
+ i: Cardinal;
+begin
+ for i := 0 to Length(input)-1 do
+ begin
+ Result := Result + digits[input[i] shr 4] + digits[input[i] and $0F];
+ end;
+end;
+
end.
interface
type
+ TByteArray = array of byte;
+
+type
TMHash384Ver = record
Major: LongWord;
Minor: LongWord;
TMHash384 = Class
public
constructor Create();
+ destructor Destroy(); override;
+ procedure Update(const input: TByteArray); overload;
+ procedure Update(const input: TByteArray; const offset: LongWord; const len: LongWord); overload;
+ procedure Result(var hash: TByteArray);
class procedure GetVer(var Version: TMHash384Ver);
private
handle: Pointer;
end;
+const
+ MHASH384_LEN: Cardinal = 48;
+
{===========================================================================}
{ IMPLEMENTATION }
{===========================================================================}
const MHash384Lib = 'MHashDelphi384.dll';
-function mhash384_native_create(): Pointer; cdecl; external MHash384Lib name 'mhash384_create';
+function mhash384_native_create(): Pointer; cdecl; external MHash384Lib name 'mhash384_create';
procedure mhash384_native_getver(major: PLongWord; minor: PLongWord; patch: PLongWord); cdecl; external MHash384Lib name 'mhash384_getver';
+procedure mhash384_native_update(handle: Pointer; const buffer: PByte; offset: LongWord; len: LongWord); cdecl; external MHash384Lib name 'mhash384_update';
+procedure mhash384_native_result(handle: Pointer; buffer: PByte); cdecl; external MHash384Lib name 'mhash384_result';
+procedure mhash384_native_freeup(handle: Pointer); cdecl; external MHash384Lib name 'mhash384_freeup';
{----------------------------------------------}
{ Public Functions }
handle := mhash384_native_create();
end;
+destructor TMHash384.Destroy();
+begin
+ if Assigned(handle) then
+ begin
+ mhash384_native_freeup(handle);
+ handle := nil;
+ end;
+end;
+
+procedure TMHash384.Update(const input: TByteArray);
+begin
+ Update(input, 0, Length(input));
+end;
+
+procedure TMHash384.Update(const input: TByteArray; const offset: LongWord; const len: LongWord);
+begin
+ mhash384_native_update(handle, @input[0], offset, len);
+end;
+
+procedure TMHash384.Result(var hash: TByteArray);
+begin
+ SetLength(hash, MHASH384_LEN);
+ mhash384_native_result(handle, @hash[0]);
+end;
+
class procedure TMHash384.GetVer(var Version: TMHash384Ver);
begin
mhash384_native_getver(@Version.major, @Version.minor, @Version.patch);
OSDN Git Service
