unit ads_ApUpdate;
{Copyright(c)2016 Advanced Delphi Systems
Richard Maley
Advanced Delphi Systems
12613 Maidens Bower Drive
Potomac, MD 20854 USA
phone 301-840-1554
dickmaley@advdelphisys.com
The code herein can be used or modified by anyone. Please retain references
to Richard Maley at Advanced Delphi Systems. If you make improvements to the
code please send your improvements to dickmaley@advdelphisys.com so that the
entire Delphi community can benefit. All comments are welcome.
}
(*
Things to do:
- Recompile Update.exe as ESAUpdateAp.exe
- need a public login other than olmsadm
- need to get informix role information
- need to modify the versions table to accommodate informix role
- need to implement roles in ESA_Public database
*)
(*UnitIndex Master Index Implementation Section Download UnitsDescription: ads_ApUpdate.pas This unit contains the following routines.
TESAApUpdateCustom.ChkEsqlAuthorization TESAApUpdateCustom.ConvertIntegerToBinaryString TESAApUpdateCustom.ConvertWordToBinaryString TESAApUpdateCustom.Execute TESAApUpdateCustom.FileDate TESAApUpdateCustom.FileDatesSame TESAApUpdateCustom.FilesInDirDetail TESAApUpdateCustom.GetIniVar TESAApUpdateCustom.GetInstallPath TESAApUpdateCustom.GetKillAppOnUserStop TESAApUpdateCustom.GetLogUserUpdates TESAApUpdateCustom.GetMustInstallShield TESAApUpdateCustom.GetUserCanStopVersionUpdate TESAApUpdateCustom.GetUserRole TESAApUpdateCustom.GetVersionBuildNumberin TESAApUpdateCustom.GetVersionNumbersg TESAApUpdateCustom.GetVersionUpdateType TESAApUpdateCustom.IniGetStringValue TESAApUpdateCustom.IniSetStringValue TESAApUpdateCustom.IsUpdateRequired TESAApUpdateCustom.IsUpdateRequiredDateTime TESAApUpdateCustom.LogUserVersion TESAApUpdateCustom.SetESAProgram TESAApUpdateCustom.SetInformixRole TESAApUpdateCustom.SetUpdateExecutable TESAApUpdateCustom.SetUpdateLocatorAliasName TESAApUpdateCustom.SetUpdateLocatorDatabaseName TESAApUpdateCustom.SetUpdateLocatorTableName TESAApUpdateCustom.SetUpdateLocatorUserName TESAApUpdateCustom.SetUpdateLocatorUserPw TESAApUpdateCustom.SetUserName TESAApUpdateCustom.SetUserVersionLogTableName TESAApUpdateCustom.UpdateThisApplication TESAApUpdateCustom.UserIDFromWindows UpdateApplication
*)
interface
Uses
DsgnIntf, dbtables, SysUtils, Dialogs, IniFiles, Classes, Forms,
Wintypes, FileCtrl, Controls;
type
TESAApUpdateCustom = class(TComponent)
private
FESAProgram : String;
FInformixRole : String;
FUpdateExecutable : String;
FUpdateLocatorAliasName : String;
FUpdateLocatorDatabaseName: String;
FUpdateLocatorTableName : String;
FUpdateLocatorUserName : String;
FUpdateLocatorUserPw : String;
FUserName : String;
FUserVersionLogTableName : String;
Function ConvertIntegerToBinaryString(Int, Length : Integer) : ShortString;
Function ConvertWordToBinaryString(InputWord : Word; Length : Integer) : ShortString;
Function FileDate(FileString: String): TDateTime;
Function FileDatesSame(FileString1,FileString2: String): Boolean;
Function FilesInDirDetail(FileList: TStrings;Directory,Mask: String;Intersection,IsReadOnly,IsHidden,IsSystem,IsVolumeID,IsDirectory,IsArchive,IsNormal,InclDotFiles: Boolean): Boolean;
Function GetInstallPath(sgOrganization,ApName: String): String;
Function GetKillAppOnUserStop(fnInstallPathAndIniFileName, sgIniSection: String): Boolean;
Function GetLogUserUpdates(fnInstallPathAndIniFileName, sgIniSection: String): Boolean;
Function GetMustInstallShield(fnInstallPathAndIniFileName, sgIniSection : String): Boolean;
Function GetUserCanStopVersionUpdate(fnInstallPathAndIniFileName, sgIniSection: String): Boolean;
Function GetUserRole(sgOrganization,sgApName: String): String;
Function GetVersionBuildNumberin(sgApName : String): Integer;
Function GetVersionNumbersg(sgApName : String): String;
Function GetVersionUpdateType(fnInstallPathAndIniFileName, sgIniSection: String): String;
Function IniGetStringValue(TheIniFile,IniSection,StringName,DefaultString: String): String;
Function IniSetStringValue(TheIniFile,IniSection,StringName,StringValue: String): Boolean;
Function IsUpdateRequired(sgVersionUpdateType, sgApName, sgInstallPath: String): Boolean;
Function IsUpdateRequiredDateTime(sgInstallPath : String): Boolean;
Function LogUserVersion(sgOrganization, sgApName : String): Boolean;
Function UpdateThisApplication(sgOrganization : String): Boolean;
Function UserIDFromWindows: string;
procedure ChkEsqlAuthorization;
Procedure GetIniVar(Var IniVariable : String;IniFile,IniSection,IniVarName,IniVarDefault : String);
procedure SetESAProgram(const Value: String);
procedure SetInformixRole(const Value: String);
procedure SetUpdateExecutable(const Value: String);
procedure SetUpdateLocatorAliasName(const Value: String);
procedure SetUpdateLocatorDatabaseName(const Value: String);
procedure SetUpdateLocatorTableName(const Value: String);
procedure SetUpdateLocatorUserName(const Value: String);
procedure SetUpdateLocatorUserPw(const Value: String);
procedure SetUserName(const Value: String);
procedure SetUserVersionLogTableName(const Value: String);
protected
Property UpdateExecutable : String read FUpdateExecutable write SetUpdateExecutable;
Property UpdateLocatorAliasName : String read FUpdateLocatorAliasName write SetUpdateLocatorAliasName;
Property UpdateLocatorDatabaseName : String read FUpdateLocatorDatabaseName write SetUpdateLocatorDatabaseName;
Property UpdateLocatorTableName : String read FUpdateLocatorTableName write SetUpdateLocatorTableName;
Property UpdateLocatorUserName : String read FUpdateLocatorUserName write SetUpdateLocatorUserName;
Property UpdateLocatorUserPw : String read FUpdateLocatorUserPw write SetUpdateLocatorUserPw;
Property UserVersionLogTableName : String read FUserVersionLogTableName write SetUserVersionLogTableName;
public
{Standard Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy ; override;
function Execute: Boolean;
Property UserName : String read FUserName write SetUserName;
Property InformixRole : String read FInformixRole write SetInformixRole;
property ESAProgram : String read FESAProgram write SetESAProgram;
end;
TESAApUpdate = class(TESAApUpdateCustom)
Published
property ESAProgram;
End;
Function UpdateApplication(sgOrganization : String): Boolean;
procedure Register;
implementation
constructor TESAApUpdateCustom.Create(AOwner: TComponent);
begin
inherited Create (AOwner);
//Put code below this line
FInformixRole := '';
FUserName := UserIDFromWindows;
FESAProgram := '';
FUpdateLocatorAliasName := 'std_odbc_central';
FUpdateLocatorDatabaseName := 'ESA_Public';
FUpdateLocatorUserName := 'olmsadm';
FUpdateLocatorUserPw := 'olmsnew';
FUpdateLocatorTableName := 'ApInstallDir';
FUserVersionLogTableName := 'ApVersions';
FUpdateExecutable := 'ESAUpdateAp.exe';
//Put code above this line
end;
destructor TESAApUpdateCustom.Destroy;
begin
//Put code below this line
//Put code above this line
inherited Destroy;
end;
//Unit Description UnitIndex Master Index
function TESAApUpdateCustom.Execute: Boolean;
begin
Result := UpdateThisApplication(ESAProgram);
end;
{!~ Returns the Windows User ID.}
//Unit Description UnitIndex Master Index
Function TESAApUpdateCustom.UserIDFromWindows: string;
Var
sgUserName : string;
UserNameLen : Dword;
Begin
UserNameLen := 255;
SetLength(sgUserName, UserNameLen);
If GetUserName(PChar(sgUserName), UserNameLen) Then
Result := Copy(sgUserName,1,UserNameLen - 1)
Else
Result := 'Unknown';
End;
{!~ Returns The Files Date Time Stamp as TDateTime.
Returns 0 if there is an error}
//Unit Description UnitIndex Master Index
Function TESAApUpdateCustom.FileDate(FileString: String): TDateTime;
Begin
Result := 0;
Try
If Not FileExists(FileString) Then Exit;
Result := FileDateToDateTime(FileAge(FileString));
Except
Result := 0;
End;
End;
{!~ Returns True is the filoe dates are the same, False otherwise.}
//Unit Description UnitIndex Master Index
Function TESAApUpdateCustom.FileDatesSame(FileString1,FileString2: String): Boolean;
Begin
Try
If FileDate(FileString1)=FileDate(FileString2) Then
Begin
Result := True;
End
Else
Begin
Result := False;
End;
Except
Result := True;
End;
End;
//Unit Description UnitIndex Master Index
Function TESAApUpdateCustom.ConvertWordToBinaryString(InputWord : Word; Length : Integer) : ShortString;
var
Counter, Number : Cardinal;
D : Array[0..1] of Char;
Begin
D[0] := '0';
D[1] := '1';
Number := 1;
Result[0] := #16;
For Counter := 15 Downto 0 Do
Begin
Result[Number] :=
D[Ord(InputWord and (1 shl Counter) <> 0)];
Inc(Number);
End;
If Length > 16 Then Length := 16;
If Length < 1 Then Length := 1;
Result := Copy(Result,16-Length,Length);
End;
{!~ Converts an integer value to its binary equivalent
as a ShortString }
//Unit Description UnitIndex Master Index
Function TESAApUpdateCustom.ConvertIntegerToBinaryString(Int, Length : Integer) : ShortString;
Begin
Result := ConvertWordToBinaryString(Word(Int),Length);
End;
{!~ Populates a TStrings FileList with the files meeting selected
file attribute criteria in a directory. The mask argument is a
standard DOS file argument like '*.*. The InclDotFiles argument
allows the user to exclude the system files "." and ".." by
setting the value to False. If the Intersection argument is set
to true then the result will reflect only those files that satisfy
all attribute criteria. If Intersection is set to false then the
result will be a union of files that meet any of the criteria.}
//Unit Description UnitIndex Master Index
Function TESAApUpdateCustom.FilesInDirDetail(
FileList : TStrings;
Directory : String;
Mask : String;
Intersection: Boolean;
IsReadOnly : Boolean;
IsHidden : Boolean;
IsSystem : Boolean;
IsVolumeID : Boolean;
IsDirectory : Boolean;
IsArchive : Boolean;
IsNormal : Boolean;
InclDotFiles: Boolean): Boolean;
var
j : Integer;
MaskPtr : PChar;
Ptr : PChar;
FileInfo : TSearchRec;
CurDir : String;
FileType : TFileType;
FileTypeI : Integer;
FileTypeB : ShortString;
TSList : TStringList;
BinaryAttr : ShortString;
ShouldAdd : Boolean;
begin
TSList := TStringList.Create();
Try
Try
FileType := [];
If IsReadOnly Then FileType := (FileType + [ftReadOnly]);
If IsHidden Then FileType := (FileType + [ftHidden]);
If IsSystem Then FileType := (FileType + [ftSystem]);
If IsVolumeID Then FileType := (FileType + [ftVolumeID]);
If IsDirectory Then FileType := (FileType + [ftDirectory]);
If IsArchive Then FileType := (FileType + [ftArchive]);
If IsNormal Then FileType := (FileType + [ftNormal]);
FileTypeI := 0;
If IsReadOnly Then FileTypeI := (FileTypeI + 1);
If IsHidden Then FileTypeI := (FileTypeI + 2);
If IsSystem Then FileTypeI := (FileTypeI + 4);
If IsVolumeID Then FileTypeI := (FileTypeI + 8);
If IsDirectory Then FileTypeI := (FileTypeI + 16);
If IsArchive Then FileTypeI := (FileTypeI + 32);
If IsNormal Then FileTypeI := (FileTypeI + 128);
FileTypeB := ConvertIntegerToBinaryString(FileTypeI,8);
TSList.Clear;
GetDir(0,CurDir);
ChDir(Directory); { go to the directory we want }
FileList.Clear; { clear the list }
MaskPtr := PChar(Mask);
while MaskPtr <> nil do
begin
Ptr := StrScan (MaskPtr, ';');
If Ptr <> nil Then Ptr^ := #0;
If FindFirst(MaskPtr, 191, FileInfo) = 0 Then
Begin
Repeat { exclude normal files if ftNormal not set }
Begin
If ftNormal in FileType Then
Begin
TSList.Add(FileInfo.Name);
End
Else
Begin
BinaryAttr := ConvertIntegerToBinaryString(FileInfo.Attr,8);
If Intersection Then
Begin
ShouldAdd := True;
For j := 1 To 8 Do
Begin
If (FileTypeB[j]='1') And (BinaryAttr[j]<>'1') Then
Begin
ShouldAdd := False;
Break;
End;
End;
If ShouldAdd Then
TSList.Add(FileInfo.Name);
End
Else
Begin
For j := 1 To 8 Do
Begin
If (FileTypeB[j]='1') And (BinaryAttr[j]='1') Then
Begin
TSList.Add(FileInfo.Name);
Break;
End;
End;
End;
End;
End;
Until FindNext(FileInfo) <> 0;
FindClose(FileInfo.FindHandle);
End;
If Ptr <> nil then
begin
Ptr^ := ';';
Inc (Ptr);
end;
MaskPtr := Ptr;
end;
ChDir(CurDir);
TSList.Sorted := False;
If Not InclDotFiles Then
Begin
If TSList.IndexOf('.') > -1 Then
TSLIst.Delete(TSList.IndexOf('.'));
If TSList.IndexOf('..') > -1 Then
TSLIst.Delete(TSList.IndexOf('..'));
End;
TSList.Sorted := True;
TSList.Sorted := False;
FileList.Assign(TSList);
Result := True;
Except
Result := False;
End;
Finally
TSList.Free;
End;
end;
{!~ Returns the ini value for a variable (StringName)
in the ini section (IniSection) of the ini file (TheIniFile).}
//Unit Description UnitIndex Master Index
Function TESAApUpdateCustom.IniGetStringValue(
TheIniFile : String;
IniSection : String;
StringName : String;
DefaultString : String): String;
Var
TheIni : TIniFile;
Begin
TheIni := TIniFile.Create(TheIniFile);
Try
Result :=
TheIni.ReadString(
IniSection,
StringName,
DefaultString);
If Result = '' Then
Begin
Result := DefaultString;
End;
Finally
TheIni.Free;
End;
End;
{!~ Sets a variable (StringName) in the ini section (IniSection)
of the ini file (TheIniFile) with the value (StringValue).
If an exception is thrown the function returns False,
True otherwise.}
//Unit Description UnitIndex Master Index
Function TESAApUpdateCustom.IniSetStringValue(
TheIniFile : String;
IniSection : String;
StringName : String;
StringValue : String): Boolean;
Var
TheIni : TIniFile;
Begin
{ Result := False;}{zzz}
TheIni := TIniFile.Create(TheIniFile);
Try
Try
TheIni.WriteString(
IniSection,
StringName,
StringValue);
Result := True;
Except
Result := False;
End;
Finally
TheIni.Free;
End;
End;
{Return the Path to this application's installation directory}
//Unit Description UnitIndex Master Index
Function TESAApUpdateCustom.GetInstallPath(
sgOrganization : String;
ApName : String): String;
Var
Database : TDatabase;
Query : TQuery;
Begin
Result := '';
Database := TDatabase.Create(nil);
Query := TQuery.Create(nil);
Try
Try
Database.Connected := False;
Database.AliasName := UpdateLocatorAliasName;
Database.DatabaseName := 'GetInstallPathDBName';
Database.KeepConnection := False;
Database.LoginPrompt := False;
Database.Params.Clear;
Database.Params.Add('DATABASE NAME='+UpdateLocatorDatabaseName);
Database.Params.Add('USER NAME='+UpdateLocatorUserName);
Database.Params.Add('ODBC DSN='+UpdateLocatorAliasName);
Database.Params.Add('OPEN MODE=READ/WRITE');
Database.Params.Add('BATCH COUNT=200');
Database.Params.Add('LANGDRIVER=');
Database.Params.Add('MAX ROWS=-1');
Database.Params.Add('SCHEMA CACHE DIR=');
Database.Params.Add('SCHEMA CACHE SIZE=8');
Database.Params.Add('SCHEMA CACHE TIME=-1');
Database.Params.Add('SQLPASSTHRU MODE=SHARED AUTOCOMMIT');
Database.Params.Add('SQLQRYMODE=');
Database.Params.Add('ENABLE SCHEMA CACHE=FALSE');
Database.Params.Add('ENABLE BCD=FALSE');
Database.Params.Add('ROWSET SIZE=20');
Database.Params.Add('BLOBS TO CACHE=64');
Database.Params.Add('BLOB SIZE=32');
Database.Params.Add('PASSWORD='+UpdateLocatorUserPw);
ChkEsqlAuthorization;
try
Database.Connected := True;
except
on EDBEngineError do Exit;
end;
Query.Active := False;
Query.DatabaseName := Database.DatabaseName;
Query.Sql.Clear;
Query.Sql.Add('Select');
Query.Sql.Add('Install_Path');
Query.Sql.Add('From');
If Pos('.DB',UpperCase(UpdateLocatorTableName)) > 0 Then
Begin
Query.Sql.Add('"'+UpdateLocatorTableName+'"');
End
Else
Begin
Query.Sql.Add(UpdateLocatorTableName);
End;
Query.Sql.Add('Where');
Query.Sql.Add('Organization Like "'+sgOrganization+'%"');
Query.Sql.Add('And');
Query.Sql.Add('Length(Organization) = '+IntToStr(Length(sgOrganization)));
Query.Sql.Add('And');
Query.Sql.Add('Application_Name Like "'+ApName+'%"');
Query.Sql.Add('And');
Query.Sql.Add('Length(Application_Name) = '+IntToStr(Length(ApName)));
Query.Active := True;
Query.First;
If Query.BOF And Query.EOF Then
Begin
Result := '';
End
Else
Begin
Result := Query.FieldByName('Install_Path').AsString;
End;
Except
Result := '';
End;
Finally
Query.Active := False;
Database.Connected := False;
Query.Free;
Database.Free;
End;
End;
//Unit Description UnitIndex Master Index
Procedure TESAApUpdateCustom.GetIniVar(
Var IniVariable : String;
IniFile : String;
IniSection : String;
IniVarName : String;
IniVarDefault : String);
Begin
IniVariable :=
IniGetStringValue(
IniFile, //TheIniFile : String;
IniSection, //IniSection : String;
IniVarName, //StringName : String;
''); //DefaultString : String): String;
{Try to update ini if possible}
If IniVariable = '' Then
Begin
If IniVarDefault <> '' Then
Begin
IniVariable := IniVarDefault;
Try
IniSetStringValue(
IniFile, //TheIniFile : String;
IniSection, //IniSection : String;
IniVarName, //StringName : String;
IniVariable); //StringValue : String): Boolean;
Except
End;
End;
End;
End;
//Unit Description UnitIndex Master Index
Function TESAApUpdateCustom.GetVersionUpdateType(
fnInstallPathAndIniFileName : String; //IniFile : String;
sgIniSection : String) //IniSection : String;
: String;
Var
sgVersionUpdateTypeOptions : String;
sgVersionUpdateType : String;
Begin
GetIniVar(
sgVersionUpdateTypeOptions,//Var IniVariable : String;
fnInstallPathAndIniFileName,//IniFile : String;
sgIniSection, //IniSection : String;
'VersionUpdateTypeOptions', //IniVarName : String;
'DateTime,BuildAll,Version,NoUpdate');//IniVarDefault : String);
GetIniVar(
sgVersionUpdateType, //Var IniVariable : String;
fnInstallPathAndIniFileName,//IniFile : String;
sgIniSection, //IniSection : String;
'VersionUpdateType', //IniVarName : String;
'DateTime'); //IniVarDefault : String);
Result := sgVersionUpdateType;
End;
//Unit Description UnitIndex Master Index
Function TESAApUpdateCustom.GetUserCanStopVersionUpdate(
fnInstallPathAndIniFileName : String; //IniFile : String;
sgIniSection : String) //IniSection : String;
: Boolean;
Var
sgUserCanStopVersionUpdateOptions : String;
sgUserCanStopVersionUpdate : String;
Begin
GetIniVar(
sgUserCanStopVersionUpdateOptions,//Var IniVariable : String;
fnInstallPathAndIniFileName, //IniFile : String;
sgIniSection, //IniSection : String;
'UserCanStopVersionUpdateOptions',//IniVarName : String;
'True,False'); //IniVarDefault : String);
GetIniVar(
sgUserCanStopVersionUpdate, //Var IniVariable : String;
fnInstallPathAndIniFileName, //IniFile : String;
sgIniSection, //IniSection : String;
'UserCanStopVersionUpdate', //IniVarName : String;
'True'); //IniVarDefault : String);
If UpperCase(sgUserCanStopVersionUpdate) = 'TRUE' Then
Begin
Result := True;
End
Else
Begin
Result := False;
End;
End;
//Unit Description UnitIndex Master Index
Function TESAApUpdateCustom.GetKillAppOnUserStop(
fnInstallPathAndIniFileName : String; //IniFile : String;
sgIniSection : String) //IniSection : String;
: Boolean;
Var
sgKillAppOnUserStopOptions : String;
sgKillAppOnUserStop : String;
Begin
GetIniVar(
sgKillAppOnUserStopOptions, //Var IniVariable : String;
fnInstallPathAndIniFileName, //IniFile : String;
sgIniSection, //IniSection : String;
'KillAppOnUserStopOptions', //IniVarName : String;
'True,False'); //IniVarDefault : String);
GetIniVar(
sgKillAppOnUserStop, //Var IniVariable : String;
fnInstallPathAndIniFileName, //IniFile : String;
sgIniSection, //IniSection : String;
'KillAppOnUserStop', //IniVarName : String;
'False'); //IniVarDefault : String);
If UpperCase(sgKillAppOnUserStop) = 'TRUE' Then
Begin
Result := True;
End
Else
Begin
Result := False;
End;
End;
//Unit Description UnitIndex Master Index
Function TESAApUpdateCustom.GetMustInstallShield(
fnInstallPathAndIniFileName : String; //IniFile : String;
sgIniSection : String) //IniSection : String;
: Boolean;
Var
sgMustInstallShieldOptions : String;
sgMustInstallShield : String;
Begin
GetIniVar(
sgMustInstallShieldOptions, //Var IniVariable : String;
fnInstallPathAndIniFileName, //IniFile : String;
sgIniSection, //IniSection : String;
'MustInstallShieldOptions', //IniVarName : String;
'True,False'); //IniVarDefault : String);
GetIniVar(
sgMustInstallShield, //Var IniVariable : String;
fnInstallPathAndIniFileName, //IniFile : String;
sgIniSection, //IniSection : String;
'MustInstallShield', //IniVarName : String;
'False'); //IniVarDefault : String);
If UpperCase(sgMustInstallShield) = 'TRUE' Then
Begin
Result := True;
End
Else
Begin
Result := False;
End;
End;
//Unit Description UnitIndex Master Index
Function TESAApUpdateCustom.GetLogUserUpdates(
fnInstallPathAndIniFileName : String; //IniFile : String;
sgIniSection : String) //IniSection : String;
: Boolean;
Var
sgLogUserUpdatesOptions : String;
sgLogUserUpdates : String;
Begin
GetIniVar(
sgLogUserUpdatesOptions, //Var IniVariable : String;
fnInstallPathAndIniFileName, //IniFile : String;
sgIniSection, //IniSection : String;
'LogUserUpdatesOptions', //IniVarName : String;
'True,False'); //IniVarDefault : String);
GetIniVar(
sgLogUserUpdates, //Var IniVariable : String;
fnInstallPathAndIniFileName, //IniFile : String;
sgIniSection, //IniSection : String;
'LogUserUpdates', //IniVarName : String;
'False'); //IniVarDefault : String);
If UpperCase(sgLogUserUpdates) = 'TRUE' Then
Begin
Result := True;
End
Else
Begin
Result := False;
End;
End;
{!~ Returns the Version number of an executable.}
//Unit Description UnitIndex Master Index
Function TESAApUpdateCustom.GetVersionNumbersg(
sgApName : String): String;
const
kInfoNum = 11;
InfoStr : array [1..kInfoNum] of String =
('CompanyName', 'FileDescription', 'FileVersion', 'InternalName',
'LegalCopyright', 'LegalTradeMarks', 'OriginalFilename',
'ProductName', 'ProductVersion', 'Comments', 'Author');
LabelStr : array [1..kInfoNum] of String =
('Company Name', 'Description', 'File Version', 'Internal Name',
'Copyright', 'TradeMarks', 'Original File Name',
'Product Name', 'Product Version', 'Comments', 'Author');
var
sgVersion : String;
{$IFDEF VER100}
inn, inLen : Integer;
{$ELSE}
inn, inLen : Cardinal;
{$ENDIF}
pcBuf : PChar;
pcValue : PChar;
begin
Try
sgVersion := '';
inn := GetFileVersionInfoSize(PChar(sgApName),inn);
If inn > 0 Then
Begin
pcBuf := AllocMem(inn);
GetFileVersionInfo(PChar(sgApName),0,inn,pcBuf);
If VerQueryValue(pcBuf,PChar('StringFileInfo\040904E4\'+
InfoStr[3]),Pointer(pcValue),inLen) Then
Begin
If Length(pcValue) > 0 Then
Begin
sgVersion := pcValue;
End;
End;
FreeMem(pcBuf,inn);
End
Else
Begin
sgVersion := '';
End;
Result := sgVersion;
Except
Result := sgVersion;
End;
End;
{!~ Returns the Build number from the version information of an executable.}
//Unit Description UnitIndex Master Index
Function TESAApUpdateCustom.GetVersionBuildNumberin(
sgApName : String): Integer;
Var
sgVersion : String;
sgBuildNum : String;
inBuildNum : Integer;
ini : Integer;
inLen : Integer;
Begin
sgVersion := GetVersionNumbersg(sgApName);
sgBuildNum := '0';
If sgVersion = '' Then
Begin
//
End
Else
Begin
inLen := Length(sgVersion);
For ini := inLen DownTo 1 Do
Begin
If Copy(sgVersion,ini,1) = '.' Then
Begin
sgBuildNum := Copy(sgVersion,ini+1,inLen-(ini+1)+1);
Break;
End;
End;
End;
Try
inBuildNum := StrToInt(sgBuildNum);
Except
inBuildNum := 0;
End;
Result := inBuildNum;
End;
//Unit Description UnitIndex Master Index
Function TESAApUpdateCustom.IsUpdateRequiredDateTime(
sgInstallPath : String
): Boolean;
Var
lstFileList : TStringList;
fnSource : String;
fnDestination : String;
sgApNameFull : String;
sgApName : String;
i,j : Integer;
FileName : String;
Begin
sgApNameFull := ExtractFileName(Application.ExeName);
sgApName := Copy(sgApNameFull,1,Length(sgApNameFull)-4);
fnDestination := ExtractFilePath(Application.ExeName);
fnSource := sgInstallPath;
lstFileList := TStringList.Create();
Try
If FilesInDirDetail(
lstFileList, //FileList : TStrings;
fnSource, //Directory : String;
'*.*', //Mask : String;
True, //Intersection: Boolean;
False, //IsReadOnly : Boolean;
False, //IsHidden : Boolean;
False, //IsSystem : Boolean;
False, //IsVolumeID : Boolean;
False, //IsDirectory : Boolean;
False, //IsArchive : Boolean;
True, //IsNormal : Boolean;
False) //InclDotFiles: Boolean)
Then
Begin
//Eliminate the InstallShield Setup.exe file from the list
i := lstFileList.IndexOf('Setup.exe');
If i <> -1 Then lstFileList.Delete(i);
//Eliminate the "ExecutableName.ini" file from the list
i := lstFileList.IndexOf(sgApName+'.ini');
If i <> -1 Then lstFileList.Delete(i);
//Eliminate this Update executable from the list
i := lstFileList.IndexOf(UpdateExecutable);
If i <> -1 Then lstFileList.Delete(i);
//If there are other files that should be eliminated they should be eliminated here
{}
//Create Final List of files to be copied
//eliminate files that have the same date time stamp
For j := (lstFileList.Count - 1) DownTo 0 Do
Begin
FileName := lstFileList[j];
If FileExists(fnDestination+FileName) Then
Begin
If FileDatesSame(
fnSource + FileName,
fnDestination + FileName)
Then
Begin
i := lstFileList.IndexOf(FileName);
If i <> -1 Then lstFileList.Delete(i);
End;
End;
End;
End;
Finally
Result := (lstFileList.Count > 0);
lstFileList.Free;
End;
End;
//Unit Description UnitIndex Master Index
Function TESAApUpdateCustom.IsUpdateRequired(
sgVersionUpdateType : String;
sgApName : String;
sgInstallPath : String
): Boolean;
Begin
sgVersionUpdateType := UpperCase(sgVersionUpdateType);
Result := False;
If sgVersionUpdateType = 'NOUPDATE' Then
Begin
//Updates are turned off
Exit;
End;
If sgVersionUpdateType = 'DATETIME' Then
Begin
//Compare file Date Time stamps
Result := IsUpdateRequiredDateTime(sgInstallPath);
End
Else
Begin
If sgVersionUpdateType = 'BUILDALL' Then
Begin
//Compare BuildAll Parameters in Version numbers
If GetVersionBuildNumberin(Application.ExeName) =
GetVersionBuildNumberin(sgInstallPath+sgApName)
Then
Begin
Result := False;
End
Else
Begin
Result := True;
End;
End
Else
Begin
//Compare Version numbers
If GetVersionNumbersg(Application.ExeName) =
GetVersionNumbersg(sgInstallPath+sgApName)
Then
Begin
Result := False;
End
Else
Begin
Result := True;
End;
End;
End;
End;
{Log the user's version.}
//Unit Description UnitIndex Master Index
Function TESAApUpdateCustom.LogUserVersion(
sgOrganization : String;
sgApName : String): Boolean;
Var
Database : TDatabase;
Query : TQuery;
sgUserID : String;
sgVersion : String;
dtExeDate : TDateTime;
Begin
Result := False;
Database := TDatabase.Create(nil);
Query := TQuery.Create(nil);
Try
Try
Database.Connected := False;
Database.AliasName := UpdateLocatorAliasName;
Database.DatabaseName := 'GetInstallPathDBName';
Database.KeepConnection := False;
Database.LoginPrompt := False;
Database.Params.Clear;
Database.Params.Add('DATABASE NAME='+UpdateLocatorDatabaseName);
Database.Params.Add('USER NAME='+UpdateLocatorUserName);
Database.Params.Add('ODBC DSN='+UpdateLocatorAliasName);
Database.Params.Add('OPEN MODE=READ/WRITE');
Database.Params.Add('BATCH COUNT=200');
Database.Params.Add('LANGDRIVER=');
Database.Params.Add('MAX ROWS=-1');
Database.Params.Add('SCHEMA CACHE DIR=');
Database.Params.Add('SCHEMA CACHE SIZE=8');
Database.Params.Add('SCHEMA CACHE TIME=-1');
Database.Params.Add('SQLPASSTHRU MODE=SHARED AUTOCOMMIT');
Database.Params.Add('SQLQRYMODE=');
Database.Params.Add('ENABLE SCHEMA CACHE=FALSE');
Database.Params.Add('ENABLE BCD=FALSE');
Database.Params.Add('ROWSET SIZE=20');
Database.Params.Add('BLOBS TO CACHE=64');
Database.Params.Add('BLOB SIZE=32');
Database.Params.Add('PASSWORD='+UpdateLocatorUserPw);
ChkEsqlAuthorization;
try
Database.Connected := True;
except
on EDBEngineError do Exit;
end;
sgUserID := UserIDFromWindows;
sgVersion := GetVersionNumbersg(ParamStr(0));
dtExeDate := FileDate(ParamStr(0));
Query.Active := False;
Query.DatabaseName := Database.DatabaseName;
Query.RequestLive := True;
Query.Sql.Clear;
Query.Sql.Add('Select *');
Query.Sql.Add('From');
If Pos('.DB',UpperCase(UserVersionLogTableName)) > 0 Then
Begin
Query.Sql.Add('"'+UserVersionLogTableName+'"');
End
Else
Begin
Query.Sql.Add(UserVersionLogTableName);
End;
Query.Sql.Add('Where');
Query.Sql.Add('Organization Like "'+sgOrganization+'%"');
Query.Sql.Add('And');
Query.Sql.Add('Length(Organization) = '+IntToStr(Length(sgOrganization)));
Query.Sql.Add('And');
Query.Sql.Add('Application_Name Like "'+sgApName+'%"');
Query.Sql.Add('And');
Query.Sql.Add('Length(Application_Name) = '+IntToStr(Length(sgApName)));
Query.Sql.Add('And');
Query.Sql.Add('User_Name Like "'+sgUserID+'%"');
Query.Sql.Add('And');
Query.Sql.Add('Length(User_Name) = '+IntToStr(Length(sgUserID)));
Query.Active := True;
Query.First;
If Query.BOF And Query.EOF Then
Begin
//No record exists
Query.Insert;
End
Else
Begin
//Record exists
If
(Query.FieldByName('Executable_Version').AsString = sgVersion)
And
(Query.FieldByName('Executable_Date').AsDateTime = dtExeDate)
Then
Begin
Exit;
End
Else
Begin
Query.Edit;
End;
End;
Query.FieldByName('Organization').AsString := sgOrganization;
Query.FieldByName('Application_Name').AsString := sgApName;
Query.FieldByName('Executable_Date').AsDateTime := dtExeDate;
Query.FieldByName('Executable_Version').AsString := sgVersion;
Query.FieldByName('User_Name').AsString := sgUserID;
Query.Post;
Result := True;
Except
Result := False;
End;
Finally
Query.Active := False;
Database.Connected := False;
Query.Free;
Database.Free;
End;
End;
{!~ Test whether the application needs to be updated. If it does then
this procedure controls the process.}
//Unit Description UnitIndex Master Index
Function TESAApUpdateCustom.UpdateThisApplication(sgOrganization : String): Boolean;
Var
sgApName : String;
sgInstallPath : String;
boUpdateRequired : Boolean;
boUpdateNow : Boolean;
boIniFound : Boolean;
sgIniFileName : String;
sgIniSection : String;
sgVersionUpdateType : String;
boUserCanStopVersionUpdate : Boolean;
boKillAppOnUserStop : Boolean;
boMustInstallShield : Boolean;
boLogUserUpdates : Boolean;
sgUpdateExeOnly : String;
MutexHandle : THandle;
Begin
Result := True;
sgApName := ExtractFileName(ParamStr(0));
sgIniFileName := Copy(sgApName,1,Length(sgApName)-4)+'.ini';
sgIniSection := 'ApplicationUpdateParameters';
InformixRole := GetUserRole(sgOrganization,sgApName);
sgInstallPath := GetInstallPath(sgOrganization, sgApName);
If sgInstallPath = '' Then
Begin
ShowMessage('Report that the Application could not be found in the Locator table');
Result := False;
Exit;
End;
If Copy(sgInstallPath,Length(sgInstallPath),1) <> '\' Then
Begin
sgInstallPath := sgInstallPath + '\';
End;
sgVersionUpdateType := GetVersionUpdateType(sgInstallPath+sgIniFileName,sgIniSection);
boUserCanStopVersionUpdate := GetUserCanStopVersionUpdate(sgInstallPath+sgIniFileName,sgIniSection);
boKillAppOnUserStop := GetKillAppOnUserStop(sgInstallPath+sgIniFileName,sgIniSection);
boMustInstallShield := GetMustInstallShield(sgInstallPath+sgIniFileName,sgIniSection);
boLogUserUpdates := GetLogUserUpdates(sgInstallPath+sgIniFileName,sgIniSection);
If boLogUserUpdates Then LogUserVersion(sgOrganization, sgApName);
boIniFound := FileExists(sgInstallPath+sgIniFileName);
If Not boIniFound Then
Begin
ShowMessage('Application Update Error - '+sgIniFileName+' file not found!');
Result := False;
Exit;
End;
boUpdateRequired :=
IsUpdateRequired(
sgVersionUpdateType,
sgApName,
sgInstallPath);
If boUpdateRequired Then
Begin
boUpdateNow := False;
//An Update is Required
//Test whether the user can stop the update
If boUserCanStopVersionUpdate Then
Begin
//User can choose to abort the update
If MessageDlg(
'The application needs to be updated. Update now?',
mtConfirmation,
[mbYes, mbNo], 0) = mrYes
Then
Begin
//User chose to update now
boUpdateNow := True;
End
Else
Begin
//User chose not to update now
//If boKillAppOnUserStop=True Then the application needs to shut down
//The user will be given one more chance
If boKillAppOnUserStop Then
Begin
If MessageDlg(
'The application will close if not updated. Update now?',
mtConfirmation,
[mbYes, mbNo], 0) = mrYes
Then
Begin
//User changed mind. Update now!
boUpdateNow := True;
End
Else
Begin
Application.Terminate;
End;
End
Else
Begin
//User chose not to update now and application can continue
Result := False;
Exit;
End;
End;
End
Else
Begin
//User has not control over the update process
boUpdateNow := True;
End;
If boUpdateNow Then
Begin
If boMustInstallShield Then
Begin
//Start InstallShield Setup.exe
If FileExists(sgInstallPath+'Setup.exe') Then
Begin
MutexHandle := CreateMutex(nil, False, PChar('Update'+ParamStr(0)));
If MutexHandle > 0 Then
Begin
WinExec(PChar(sgInstallPath+'Setup.exe'), SW_SHOW);
Application.Terminate;
End
Else
Begin
ShowMessage('Update Aborted! More than one instance of application is running.');
Halt;
End;
End
Else
Begin
ShowMessage('Update Aborted! '+sgInstallPath+'Setup.exe not found');
End;
End
Else
Begin
//Start UpdateExecutable
If FileExists(sgInstallPath+UpdateExecutable) Then
Begin
If
(UpperCase(sgVersionUpdateType) = 'BUILDALL') Or
(UpperCase(sgVersionUpdateType) = 'VERSION')
Then
Begin
sgUpdateExeOnly := 'TRUE';
End
Else
Begin
sgUpdateExeOnly := 'FALSE';
End;
MutexHandle := CreateMutex(nil, False, PChar('Update'+ParamStr(0)));
If MutexHandle > 0 Then
Begin
WinExec(
PChar(
sgInstallPath +
UpdateExecutable +
' "' +
sgInstallPath +
'" "' +
ParamStr(0) +
'" ' +
sgUpdateExeOnly),
SW_SHOW);
Application.Terminate;
End
Else
Begin
ShowMessage('Update Aborted! More than one instance of application is running.');
Halt;
End;
End
Else
Begin
ShowMessage('Update Aborted! '+sgInstallPath+UpdateExecutable+' not found');
End;
End;
End;
End;
End;
//Unit Description UnitIndex Master Indexprocedure TESAApUpdateCustom.SetUpdateExecutable(const Value: String); begin FUpdateExecutable := Value; end; //Unit Description UnitIndex Master Index
procedure TESAApUpdateCustom.SetUpdateLocatorAliasName(const Value: String); begin FUpdateLocatorAliasName := Value; end; //Unit Description UnitIndex Master Index
procedure TESAApUpdateCustom.SetUpdateLocatorDatabaseName(const Value: String); begin FUpdateLocatorDatabaseName := Value; end; //Unit Description UnitIndex Master Index
procedure TESAApUpdateCustom.SetUpdateLocatorTableName(const Value: String); begin FUpdateLocatorTableName := Value; end; //Unit Description UnitIndex Master Index
procedure TESAApUpdateCustom.SetUpdateLocatorUserName(const Value: String); begin FUpdateLocatorUserName := Value; end; //Unit Description UnitIndex Master Index
procedure TESAApUpdateCustom.SetUpdateLocatorUserPw(const Value: String); begin FUpdateLocatorUserPw := Value; end; //Unit Description UnitIndex Master Index
procedure TESAApUpdateCustom.SetUserVersionLogTableName(const Value: String); begin FUserVersionLogTableName := Value; end; //Unit Description UnitIndex Master Index
procedure TESAApUpdateCustom.SetESAProgram(const Value: String); begin FESAProgram := Value; end; //Unit Description UnitIndex Master Index
procedure TESAApUpdateCustom.SetUserName(const Value: String); begin FUserName := Value; end; //Unit Description UnitIndex Master Index
procedure TESAApUpdateCustom.SetInformixRole(const Value: String); begin FInformixRole := Value; end; //Unit Description UnitIndex Master Index
Function UpdateApplication(sgOrganization : String): Boolean;
Var
ESAApUpdate : TESAApUpdate;
Begin
ESAApUpdate := TESAApUpdate.Create(nil);
Try
ESAApUpdate.ESAProgram := sgOrganization;
Result := ESAApUpdate.Execute;
Finally
ESAApUpdate.Free;
End;
End;
{Get the user's role.}
//Unit Description UnitIndex Master Index
Function TESAApUpdateCustom.GetUserRole(
sgOrganization : String;
sgApName : String): String;
Var
Database : TDatabase;
Query : TQuery;
sgUserID : String;
sgVersion : String;
Begin
Result := '';
Database := TDatabase.Create(nil);
Query := TQuery.Create(nil);
Try
Try
Database.Connected := False;
Database.AliasName := UpdateLocatorAliasName;
Database.DatabaseName := 'GetInstallPathDBName';
Database.KeepConnection := False;
Database.LoginPrompt := False;
Database.Params.Clear;
Database.Params.Add('DATABASE NAME='+UpdateLocatorDatabaseName);
Database.Params.Add('USER NAME='+UpdateLocatorUserName);
Database.Params.Add('ODBC DSN='+UpdateLocatorAliasName);
Database.Params.Add('OPEN MODE=READ/WRITE');
Database.Params.Add('BATCH COUNT=200');
Database.Params.Add('LANGDRIVER=');
Database.Params.Add('MAX ROWS=-1');
Database.Params.Add('SCHEMA CACHE DIR=');
Database.Params.Add('SCHEMA CACHE SIZE=8');
Database.Params.Add('SCHEMA CACHE TIME=-1');
Database.Params.Add('SQLPASSTHRU MODE=SHARED AUTOCOMMIT');
Database.Params.Add('SQLQRYMODE=');
Database.Params.Add('ENABLE SCHEMA CACHE=FALSE');
Database.Params.Add('ENABLE BCD=FALSE');
Database.Params.Add('ROWSET SIZE=20');
Database.Params.Add('BLOBS TO CACHE=64');
Database.Params.Add('BLOB SIZE=32');
Database.Params.Add('PASSWORD='+UpdateLocatorUserPw);
ChkEsqlAuthorization;
try
Database.Connected := True;
except
on EDBEngineError do Exit;
end;
sgUserID := UserIDFromWindows;
sgVersion := GetVersionNumbersg(ParamStr(0));
Query.Active := False;
Query.DatabaseName := Database.DatabaseName;
Query.RequestLive := True;
Query.Sql.Clear;
Query.Sql.Add('Select *');
Query.Sql.Add('From');
If Pos('.DB',UpperCase(UserVersionLogTableName)) > 0 Then
Begin
Query.Sql.Add('"'+UserVersionLogTableName+'"');
End
Else
Begin
Query.Sql.Add(UserVersionLogTableName);
End;
Query.Sql.Add('Where');
Query.Sql.Add('Organization Like "'+sgOrganization+'%"');
Query.Sql.Add('And');
Query.Sql.Add('Length(Organization) = '+IntToStr(Length(sgOrganization)));
Query.Sql.Add('And');
Query.Sql.Add('Application_Name Like "'+sgApName+'%"');
Query.Sql.Add('And');
Query.Sql.Add('Length(Application_Name) = '+IntToStr(Length(sgApName)));
Query.Sql.Add('And');
Query.Sql.Add('User_Name Like "'+sgUserID+'%"');
Query.Sql.Add('And');
Query.Sql.Add('Length(User_Name) = '+IntToStr(Length(sgUserID)));
Query.Active := True;
Query.First;
If Query.BOF And Query.EOF Then
Begin
//No record exists
End
Else
Begin
//Record exists
Result := Query.FieldByName('User_Role').AsString;
End;
Except
End;
Finally
Query.Active := False;
Database.Connected := False;
Query.Free;
Database.Free;
End;
End;
//Unit Description UnitIndex Master Index
procedure TESAApUpdateCustom.ChkEsqlAuthorization; external 'ESQLCHECK.DLL' name 'ChkEsqlAuthorization';procedure Register;
begin
RegisterComponents('DOL-ESA', [TESAApUpdate]);
end;
end.
//