Summary Table

Categories Total Count
PII 0
URL 0
DNS 0
EKL 0
IP 0
PORT 0
VsID 0
CF 0
AI 0
VPD 0
PL 0
Other 0

File Content

unit U_Splash;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls,
Vcl.ExtCtrls, Winapi.ShellAPI, VAUtils, JAWSImplementation, Vcl.ImgList, VA508AccessibilityConst;

type
tStatus = (DS_RUN, DS_ERROR, DS_CHECK);
TExecutEvent = function(ComponentCallBackProc: TComponentDataRequestProc): BOOL;

tSplahThread = Class(TThread)
private
fOnExecute: TExecutEvent;
fTaskDialog: TTaskDialog;
fComponentCallBackProc: TComponentDataRequestProc;
protected
procedure Execute; override;
public
constructor Create(aDialog: TTaskDialog; ComponentCallBackProc: TComponentDataRequestProc);
destructor Destroy; override;
property OnExecute: TExecutEvent read fOnExecute write fOnExecute;
End;

TTreeNode = class(Vcl.ComCtrls.TTreeNode)
Private
fLogMessage: String;
fStatus: tStatus;
procedure SetStatus(aValue: tStatus);
Public
Property LogMessage: String read fLogMessage write fLogMessage;
Property Status: tStatus read fStatus write SetStatus;
end;

SplashTaskDialog = class(TComponent)
private
fTaskDialog: TTaskDialog;
fSplashThread: tSplahThread;
fTaskText: String;
fTaskTitle: String;
fProgMax: Integer;
fProgMoveBy: Integer;
fThreadResult: BOOL;
procedure SetTaskText(aValue: string);
procedure SetTaskTitle(aValue: string);
Procedure SetTaskMaxProg(aValue: integer);
procedure SyncTaskText;
procedure SyncTaskTitle;
procedure SyncIncProg;
procedure SyncMaxProg;
public
constructor Create(ExecuteEvent: TExecutEvent; ComponentCallBackProc: TComponentDataRequestProc);
destructor destroy;
Procedure IncProg(ByCnt: integer = 1);
procedure Show;
property TaskText: string read fTaskText write SetTaskText;
property TaskTitle: string read fTaskTitle write SetTaskTitle;
property TaskMaxProg: Integer read fProgMax write SetTaskMaxProg;
property ReturnValue: BOOL read fThreadResult;
end;

TfrmSplash = class(TForm)
Label1: TLabel;
ProgressBar1: TProgressBar;
lblStatus: TStaticText;
lblDescription: TStaticText;
lblDev: TStaticText;
lblVersion: TStaticText;
lblCompiled: TStaticText;
lblcopyright: TStaticText;
lblComment: TStaticText;
lblCrc: TStaticText;
Panel1: TPanel;
pnlLog: TPanel;
TVLog: TTreeView;
Panel3: TPanel;
Splitter1: TSplitter;
MemLog: TMemo;
ImageList1: TImageList;
ImageList2: TImageList;
pnlButtons: TPanel;
Button1: TButton;
Button2: TButton;
Button3: TButton;
procedure FormCreate(Sender: TObject);
procedure lblDeatailTxt1Click(Sender: TObject);
private
{ Private declarations }
fLogPath: String;
fReturnNode: TTreeNode;
fParentNode: TTreeNode;
fNOdeTexT: String;
procedure ShowVersionInfo();
function GetProgressMax: integer;
Procedure SetProgressMax(avalue: integer);
Procedure SetStatusText(avalue: string);
// procedure SetLogNode(NodeText: String);
function GetLogNode(NodeText: String): TTreeNode;
public
{ Public declarations }
property ProgressMax: integer read GetProgressMax write SetProgressMax;
Procedure IncProg(ByCnt: integer = 1);
procedure ShowLogLink(LogPath: String);
function AddToTree(ParentNode: TTreeNode; Text: string): TTreeNode;
Property StatusText: string write SetStatusText;
Property LogNode[NodeText: String]: TTreeNode read GetLogNode;// write SetLogNode;
end;

var
frmSplash: TfrmSplash;

Const
IMG_ERROR = 1;
IMG_CHECK = 2;
IMG_WAIT = 3;

implementation

{$R *.dfm}

procedure TfrmSplash.FormCreate(Sender: TObject);
begin
ShowVersionInfo;
ProgressBar1.Position := 0;
end;

procedure TfrmSplash.ShowVersionInfo();
var
CmplDte: TDateTime;
DllName, FileVersion: String;
const
{ table for calculating CRC values (DWORD is Integer in Delphi 3, Cardinal in Delphi 4 }
CRC32_TABLE: array [0 .. 255] of DWORD = ($0, $77073096, $EE0E612C, $990951BA,
$76DC419, $706AF48F, $E963A535, $9E6495A3, $EDB8832, $79DCB8A4, $E0D5E91E,
$97D2D988, $9B64C2B, $7EB17CBD, $E7B82D07, $90BF1D91, $1DB71064, $6AB020F2,
$F3B97148, $84BE41DE, $1ADAD47D, $6DDDE4EB, $F4D4B551, $83D385C7, $136C9856,
$646BA8C0, $FD62F97A, $8A65C9EC, $14015C4F, $63066CD9, $FA0F3D63, $8D080DF5,
$3B6E20C8, $4C69105E, $D56041E4, $A2677172, $3C03E4D1, $4B04D447, $D20D85FD,
$A50AB56B, $35B5A8FA, $42B2986C, $DBBBC9D6, $ACBCF940, $32D86CE3, $45DF5C75,
$DCD60DCF, $ABD13D59, $26D930AC, $51DE003A, $C8D75180, $BFD06116, $21B4F4B5,
$56B3C423, $CFBA9599, $B8BDA50F, $2802B89E, $5F058808, $C60CD9B2, $B10BE924,
$2F6F7C87, $58684C11, $C1611DAB, $B6662D3D, $76DC4190, $1DB7106, $98D220BC,
$EFD5102A, $71B18589, $6B6B51F, $9FBFE4A5, $E8B8D433, $7807C9A2, $F00F934,
$9609A88E, $E10E9818, $7F6A0DBB, $86D3D2D, $91646C97, $E6635C01, $6B6B51F4,
$1C6C6162, $856530D8, $F262004E, $6C0695ED, $1B01A57B, $8208F4C1, $F50FC457,
$65B0D9C6, $12B7E950, $8BBEB8EA, $FCB9887C, $62DD1DDF, $15DA2D49, $8CD37CF3,
$FBD44C65, $4DB26158, $3AB551CE, $A3BC0074, $D4BB30E2, $4ADFA541, $3DD895D7,
$A4D1C46D, $D3D6F4FB, $4369E96A, $346ED9FC, $AD678846, $DA60B8D0, $44042D73,
$33031DE5, $AA0A4C5F, $DD0D7CC9, $5005713C, $270241AA, $BE0B1010, $C90C2086,
$5768B525, $206F85B3, $B966D409, $CE61E49F, $5EDEF90E, $29D9C998, $B0D09822,
$C7D7A8B4, $59B33D17, $2EB40D81, $B7BD5C3B, $C0BA6CAD, $EDB88320, $9ABFB3B6,
$3B6E20C, $74B1D29A, $EAD54739, $9DD277AF, $4DB2615, $73DC1683, $E3630B12,
$94643B84, $D6D6A3E, $7A6A5AA8, $E40ECF0B, $9309FF9D, $A00AE27, $7D079EB1,
$F00F9344, $8708A3D2, $1E01F268, $6906C2FE, $F762575D, $806567CB, $196C3671,
$6E6B06E7, $FED41B76, $89D32BE0, $10DA7A5A, $67DD4ACC, $F9B9DF6F, $8EBEEFF9,
$17B7BE43, $60B08ED5, $D6D6A3E8, $A1D1937E, $38D8C2C4, $4FDFF252, $D1BB67F1,
$A6BC5767, $3FB506DD, $48B2364B, $D80D2BDA, $AF0A1B4C, $36034AF6, $41047A60,
$DF60EFC3, $A867DF55, $316E8EEF, $4669BE79, $CB61B38C, $BC66831A, $256FD2A0,
$5268E236, $CC0C7795, $BB0B4703, $220216B9, $5505262F, $C5BA3BBE, $B2BD0B28,
$2BB45A92, $5CB36A04, $C2D7FFA7, $B5D0CF31, $2CD99E8B, $5BDEAE1D, $9B64C2B0,
$EC63F226, $756AA39C, $26D930A, $9C0906A9, $EB0E363F, $72076785, $5005713,
$95BF4A82, $E2B87A14, $7BB12BAE, $CB61B38, $92D28E9B, $E5D5BE0D, $7CDCEFB7,
$BDBDF21, $86D3D2D4, $F1D4E242, $68DDB3F8, $1FDA836E, $81BE16CD, $F6B9265B,
$6FB077E1, $18B74777, $88085AE6, $FF0F6A70, $66063BCA, $11010B5C, $8F659EFF,
$F862AE69, $616BFFD3, $166CCF45, $A00AE278, $D70DD2EE, $4E048354, $3903B3C2,
$A7672661, $D06016F7, $4969474D, $3E6E77DB, $AED16A4A, $D9D65ADC, $40DF0B66,
$37D83BF0, $A9BCAE53, $DEBB9EC5, $47B2CF7F, $30B5FFE9, $BDBDF21C, $CABAC28A,
$53B39330, $24B4A3A6, $BAD03605, $CDD70693, $54DE5729, $23D967BF, $B3667A2E,
$C4614AB8, $5D681B02, $2A6F2B94, $B40BBE37, $C30C8EA1, $5A05DF1B,
$2D02EF8D);
function UpdateCrc32(Value: DWORD; var Buffer: array of Byte;
Count: integer): DWORD;
var
I: integer;
begin
Result := Value;
for I := 0 to Pred(Count) do
Result := ((Result shr 8) and $00FFFFFF) xor CRC32_TABLE
[(Result xor Buffer[I]) and $000000FF];
end;

function CRCForFile(AFileName: string): DWORD;
const
BUF_SIZE = 16383;
type
TBuffer = array [0 .. BUF_SIZE] of Byte;
var
Buffer: Pointer;
AHandle, BytesRead: integer;
begin
Result := $FFFFFFFF;
GetMem(Buffer, BUF_SIZE);
AHandle := FileOpen(AFileName, fmShareDenyWrite);
repeat
BytesRead := FileRead(AHandle, Buffer^, BUF_SIZE);
Result := UpdateCrc32(Result, TBuffer(Buffer^), BytesRead);
until BytesRead <> BUF_SIZE;
FileClose(AHandle);
FreeMem(Buffer);
Result := not Result;
end;

function GetDLLName: string;
var
aName: array [0 .. MAX_PATH] of char;
begin
fillchar(aName, SizeOf(aName), #0);
GetModuleFileName(HInstance, aName, MAX_PATH);
Result := aName;
end;

begin
DllName := GetDLLName;
lblDev.Caption := 'Developed By: ' + FileVersionValue(DllName,
FILE_VER_COMPANYNAME);


lblDescription.Caption := 'Description: ' + FileVersionValue(DllName,
FILE_VER_FILEDESCRIPTION);

FileVersion := FileVersionValue(DllName, FILE_VER_FILEVERSION);
lblVersion.Caption := 'Version: ' + FileVersion;
self.Caption := self.Caption + ' - Version: ' + FileVersion;

CmplDte := PImageNtHeaders(HInstance + Cardinal(PImageDosHeader(HInstance)
^._lfanew))^.FileHeader.TimeDateStamp / SecsPerDay + UnixDateDelta;
lblCompiled.Caption := 'Compiled: ' +
FormatDateTime('mm/dd/yyyy hh:mm', CmplDte);
lblCrc.Caption := 'CRC: ' + IntToHex(CRCForFile(DllName), 8);
lblComment.Caption := 'Comments: ' + FileVersionValue(DllName,
FILE_VER_COMMENTS);
lblcopyright.Caption := 'CopyRight: ' + FileVersionValue(DllName,
FILE_VER_LEGALCOPYRIGHT);

end;

function TfrmSplash.GetProgressMax: integer;
begin
Result := ProgressBar1.Max;
end;

Procedure TfrmSplash.SetProgressMax(avalue: integer);
begin
ProgressBar1.Max := avalue;
end;

Procedure TfrmSplash.IncProg(ByCnt: integer = 1);
begin
ProgressBar1.Position := ProgressBar1.Position + ByCnt;
Application.ProcessMessages;
end;

procedure TfrmSplash.ShowLogLink(LogPath: String);
begin
Panel1.Visible := false;
pnlLog.Visible := true;
pnlButtons.Visible := true;
fLogPath := LogPath;
end;

Procedure TfrmSplash.SetStatusText(avalue: string);
begin
lblStatus.Caption := avalue;
Application.ProcessMessages;
end;

procedure TfrmSplash.lblDeatailTxt1Click(Sender: TObject);
begin
ShellExecute(Handle, 'open', PChar(fLogPath), '', '', SW_NORMAL)
end;

function TfrmSplash.GetLogNode(NodeText: String): TTreeNode;
var
I: integer;
begin
//

end;

function TfrmSplash.AddToTree(ParentNode: TTreeNode; Text: string): TTreeNode;
begin
// fReturnNode: TTreeNode;
// fParentNode: ParentNode;
// fNOdeTexT: Text;
Result := TTreeNode(TVLog.Items.AddChild(ParentNode, Text));
end;

{procedure SplashTaskDialog.SyncAddToTree;
begin
fTaskDialog.Text := fTaskText;
SpeakText(fTaskText);
end; }

procedure SplashTaskDialog.SetTaskText(aValue: string);
begin
if Assigned(fTaskDialog) then
begin
fTaskText := aValue;
SyncTaskText;
// TThread.Synchronize(fSplashThread, SyncTaskText);
end;
end;

procedure SplashTaskDialog.SyncTaskText;
begin
fTaskDialog.Text := fTaskText;
// SpeakText(PWideChar(fTaskText));
end;

procedure SplashTaskDialog.SetTaskTitle(aValue: string);
begin
if Assigned(fTaskDialog) then
begin
fTaskTitle := aValue;
SyncTaskTitle;
// TThread.Synchronize(fSplashThread, SyncTaskTitle);
end;
end;

procedure SplashTaskDialog.SyncTaskTitle;
begin
fTaskDialog.Title := fTaskTitle;
//SpeakText(PWideChar(fTaskTitle));
end;

Procedure SplashTaskDialog.SetTaskMaxProg(aValue: integer);
begin
fProgMax := aValue;
//fSplashThread.Synchronize(fSplashThread, SyncMaxProg);
//TThread.Synchronize(fSplashThread, SyncMaxProg);
SyncMaxProg;
end;

procedure SplashTaskDialog.SyncMaxProg;
begin
fTaskDialog.ProgressBar.Max := fProgMax;
end;

Procedure SplashTaskDialog.IncProg(ByCnt: integer = 1);
begin
fProgMoveBy := ByCnt;
SyncIncProg;
// TThread.Synchronize(fSplashThread, SyncIncProg);
end;

procedure SplashTaskDialog.SyncIncProg;
begin
fTaskDialog.ProgressBar.Position := fTaskDialog.ProgressBar.Position + fProgMoveBy;
end;

constructor SplashTaskDialog.Create(ExecuteEvent: TExecutEvent; ComponentCallBackProc: TComponentDataRequestProc);
function GetDLLName: string;
var
aName: array [0 .. MAX_PATH] of char;
begin
fillchar(aName, SizeOf(aName), #0);
GetModuleFileName(HInstance, aName, MAX_PATH);
Result := aName;
end;
var
DLLName, FileVersion: string;
begin
inherited Create(nil);
DLLName := GetDLLName;
FileVersion := FileVersionValue(DllName, FILE_VER_FILEVERSION);

fTaskDialog := TTaskDialog.Create(self);
fTaskDialog.Caption := 'VA 508 Jaws Framework - Version: ' + FileVersion;;
fTaskDialog.Title := '';
fTaskDialog.Text := '';
fTaskDialog.MainIcon := tdiInformation;
fTaskDialog.flags := [tfShowProgressBar];
fTaskDialog.CommonButtons := [];
with TTaskDialogButtonItem(fTaskDialog.Buttons.Add) do
begin
Caption := 'done';
ModalResult := mrYes;
Enabled := false;
end;

//fTaskDialog.OnDialogProgress := DoDialogProgress;

fSplashThread := tSplahThread.Create(fTaskDialog, ComponentCallBackProc);
fSplashThread.OnExecute := ExecuteEvent;

end;

Procedure SplashTaskDialog.show;
begin
fSplashThread.Start;
fTaskDialog.Execute;
fThreadResult := fTaskDialog.Tag = 1;

end;

destructor SplashTaskDialog.destroy;
begin
FreeAndNil(fTaskDialog);
inherited;
end;

procedure TTreeNode.SetStatus(aValue: tStatus);
begin
case fStatus of
DS_RUN: Self.ImageIndex := IMG_WAIT;
DS_ERROR: Self.ImageIndex := IMG_ERROR;
DS_CHECK: Self.ImageIndex := IMG_CHECK;
end;
fStatus := aValue;
end;

procedure tSplahThread.Execute;
begin
if Assigned(fOnExecute) then
begin
Sleep(1000);
if fOnExecute(fComponentCallBackProc) then
fTaskDialog.Tag := 1
else
fTaskDialog.Tag := 0;
end;
end;

constructor tSplahThread.Create(aDialog: TTaskDialog; ComponentCallBackProc: TComponentDataRequestProc);
begin
inherited Create(True);
FreeOnTerminate := true;
fOnExecute := nil;
fTaskDialog := aDialog;
fComponentCallBackProc := ComponentCallBackProc;
end;

destructor tSplahThread.Destroy;
begin
fTaskDialog.Buttons[0].Click;
inherited;
end;

end.