[456] | 1 | unit ORSystem;
|
---|
| 2 |
|
---|
| 3 | {$O-}
|
---|
[829] | 4 | {$WARN SYMBOL_PLATFORM OFF}
|
---|
[456] | 5 |
|
---|
| 6 | interface
|
---|
| 7 |
|
---|
| 8 | uses SysUtils, Windows, Classes, Forms, Registry, ORFn;
|
---|
| 9 |
|
---|
| 10 | const
|
---|
| 11 | CPRS_ROOT_KEY = HKEY_LOCAL_MACHINE;
|
---|
| 12 | CPRS_USER_KEY = HKEY_CURRENT_USER;
|
---|
| 13 | CPRS_SOFTWARE = 'Software\Vista\CPRS';
|
---|
| 14 | CPRS_REG_AUTO = 'AutoUpdate';
|
---|
| 15 | CPRS_REG_GOLD = 'GoldCopyPath';
|
---|
| 16 | CPRS_REG_ONLY = 'LimitUpdate';
|
---|
| 17 | CPRS_REG_ASK = 'AskFirst';
|
---|
| 18 | CPRS_REG_LAST = 'LastUpdate-';
|
---|
| 19 | CPRS_USER_LAST = 'Software\Vista\CPRS\LastUpdate';
|
---|
| 20 | CPRS_LAST_DATE = 'Software\Vista\CPRS\DateUpdated';
|
---|
| 21 |
|
---|
| 22 | function AppOutOfDate(AppName: string): Boolean;
|
---|
| 23 | function ClientVersion(const AFileName: string): string;
|
---|
| 24 | function CompareVersion(const A, B: string): Integer;
|
---|
| 25 | procedure CopyFileDate(const Source, Dest: string);
|
---|
| 26 | procedure CopyLastWriteTime(const Source, Dest: string);
|
---|
| 27 | //procedure CopyFileWithDate(const FromFileName, ToFileName: string);
|
---|
| 28 | procedure Delay(i: Integer);
|
---|
| 29 | //procedure FileCopy(const FromFileName, ToFileName: string);
|
---|
| 30 | //procedure FileCopyWithDate(const FromFileName, ToFileName: string);
|
---|
| 31 | function FullToFilePart(const AFileName: string): string;
|
---|
| 32 | function FullToPathPart(const AFileName: string): string;
|
---|
| 33 | function IsWin95Style: Boolean;
|
---|
| 34 | function ParamIndex(const AName: string): Integer;
|
---|
| 35 | function ParamSearch(const AName: string): string;
|
---|
| 36 | function QuotedExeName: string;
|
---|
| 37 | function RegKeyExists(ARoot: HKEY; const AKey: string): Boolean;
|
---|
| 38 | function RegReadInt(const AName: string): Integer;
|
---|
| 39 | function RegReadStr(const AName: string): string;
|
---|
| 40 | function RegReadBool(const AName: string): Boolean;
|
---|
| 41 | procedure RegWriteInt(const AName: string; AValue: Integer);
|
---|
| 42 | procedure RegWriteStr(const AName, AValue: string);
|
---|
| 43 | procedure RegWriteBool(const AName: string; AValue: Boolean);
|
---|
| 44 | function UserRegReadDateTime(const AKey, AName: string): TDateTime;
|
---|
| 45 | procedure UserRegWriteDateTime(const AKey, AName: string; AValue: TDateTime);
|
---|
| 46 | function UserRegReadInt(const AKey, AName: string): Integer;
|
---|
| 47 | procedure UserRegWriteInt(const AKey, AName: string; AValue: Integer);
|
---|
| 48 | procedure RunProgram(const AppName: string);
|
---|
| 49 | function UpdateSelf: Boolean;
|
---|
[829] | 50 | function BorlandDLLVersionOK: boolean;
|
---|
[456] | 51 |
|
---|
| 52 | implementation
|
---|
| 53 |
|
---|
| 54 | const
|
---|
| 55 | CREATE_KEY = True; // cause key to be created if it's not in the registry
|
---|
| 56 |
|
---|
| 57 | function FileLastWrite(const FileName: string): LARGE_INTEGER;
|
---|
| 58 | var
|
---|
| 59 | AHandle: THandle;
|
---|
| 60 | FindData: TWin32FindData;
|
---|
| 61 | begin
|
---|
| 62 | Result.QuadPart := 0;
|
---|
| 63 | AHandle := FindFirstFile(PChar(FileName), FindData);
|
---|
| 64 | if AHandle <> INVALID_HANDLE_VALUE then
|
---|
| 65 | begin
|
---|
| 66 | Windows.FindClose(AHandle);
|
---|
| 67 | Result.LowPart := FindData.ftLastWriteTime.dwLowDateTime;
|
---|
| 68 | Result.HighPart := FindData.ftLastWriteTime.dwHighDateTime;
|
---|
| 69 | end;
|
---|
| 70 | end;
|
---|
| 71 |
|
---|
| 72 | function AppOutOfDate(AppName: string): Boolean;
|
---|
| 73 | const
|
---|
| 74 | FIVE_SECONDS = 0.000055;
|
---|
| 75 | FIVE_SECONDS_NT = 50000000;
|
---|
| 76 | var
|
---|
| 77 | GoldName, DriveRoot, x: string;
|
---|
| 78 | DriveType: Integer;
|
---|
| 79 | LastWriteApp, LastWriteGold: LARGE_INTEGER;
|
---|
| 80 | begin
|
---|
| 81 | Result := False;
|
---|
| 82 | // check command line params for no-update parameter
|
---|
| 83 | if ParamIndex('NOCOPY') > 0 then Exit;
|
---|
| 84 | // check time of last update, don't retry if too recently called
|
---|
| 85 | if Abs(Now - UserRegReadDateTime(CPRS_LAST_DATE, FullToFilePart(AppName))) < FIVE_SECONDS
|
---|
| 86 | then Exit;
|
---|
| 87 | // check auto-update registry entry
|
---|
| 88 | if RegReadBool(CPRS_REG_AUTO) = False then Exit;
|
---|
| 89 | // check directory - if remote then don't allow update
|
---|
| 90 | if Pos('\\', AppName) = 1 then Exit;
|
---|
| 91 | if Pos(':', AppName) > 0
|
---|
| 92 | then DriveRoot := Piece(AppName, ':', 1) + ':\'
|
---|
| 93 | else DriveRoot := '\';
|
---|
| 94 | DriveType := GetDriveType(PChar(DriveRoot));
|
---|
| 95 | if not ((DriveType = DRIVE_FIXED) or (DriveType = DRIVE_REMOVABLE)) then Exit;
|
---|
| 96 | // check registry to see if updates limited to particular directory
|
---|
| 97 | x := RegReadStr(CPRS_REG_ONLY);
|
---|
| 98 | if (Length(x) > 0) and (CompareText(x, FullToPathPart(AppName)) <> 0) then Exit;
|
---|
| 99 | // check for different file date in the gold directory
|
---|
| 100 | GoldName := RegReadStr(CPRS_REG_GOLD);
|
---|
[829] | 101 | if (Length(GoldName) = 0) then exit;
|
---|
| 102 | if not DirectoryExists(GoldName) then
|
---|
| 103 | begin
|
---|
| 104 | if Pos('"', Goldname) > 0 then
|
---|
| 105 | begin
|
---|
| 106 | Goldname := Copy(GoldName, 2, MaxInt);
|
---|
| 107 | if Pos('"', Goldname) > 0 then
|
---|
| 108 | Goldname := Copy(GoldName, 1, Length(GoldName) - 1);
|
---|
| 109 | end;
|
---|
| 110 | end;
|
---|
| 111 | if (not DirectoryExists(GoldName)) then Exit;
|
---|
[456] | 112 | GoldName := GoldName + FullToFilePart(AppName);
|
---|
| 113 | if FileExists(GoldName) then
|
---|
| 114 | begin
|
---|
| 115 | LastWriteApp := FileLastWrite(AppName);
|
---|
| 116 | LastWriteGold := FileLastWrite(GoldName);
|
---|
| 117 | // check within 5 seconds to work around diffs in NTFS & FAT timestamps
|
---|
| 118 | if Abs(LastWriteApp.QuadPart - LastWriteGold.QuadPart) > FIVE_SECONDS_NT then Result := True;
|
---|
| 119 | //if CompareFileTime(LastWriteApp, LastWriteGold) <> 0 then Result := True;
|
---|
| 120 | end;
|
---|
| 121 | end;
|
---|
| 122 |
|
---|
| 123 | function ClientVersion(const AFileName: string): string;
|
---|
| 124 | var
|
---|
| 125 | ASize, AHandle: DWORD;
|
---|
| 126 | Buf: string;
|
---|
| 127 | FileInfoPtr: Pointer; //PVSFixedFileInfo;
|
---|
| 128 | begin
|
---|
| 129 | Result := '';
|
---|
| 130 | ASize:=GetFileVersionInfoSize(PChar(AFileName), AHandle);
|
---|
| 131 | if ASize > 0 then
|
---|
| 132 | begin
|
---|
| 133 | SetLength(Buf, ASize);
|
---|
| 134 | GetFileVersionInfo(PChar(AFileName), AHandle, ASize, Pointer(Buf));
|
---|
| 135 | VerQueryValue(Pointer(Buf), '\', FileInfoPtr, ASize);
|
---|
| 136 | with TVSFixedFileInfo(FileInfoPtr^) do Result := IntToStr(HIWORD(dwFileVersionMS)) + '.' +
|
---|
| 137 | IntToStr(LOWORD(dwFileVersionMS)) + '.' +
|
---|
| 138 | IntToStr(HIWORD(dwFileVersionLS)) + '.' +
|
---|
| 139 | IntToStr(LOWORD(dwFileVersionLS));
|
---|
| 140 | end;
|
---|
| 141 | end;
|
---|
| 142 |
|
---|
| 143 | function CompareVersion(const A, B: string): Integer;
|
---|
| 144 | var
|
---|
| 145 | NumA, NumB: Integer;
|
---|
| 146 | begin
|
---|
| 147 | NumA := (StrToInt(Piece(A, '.', 1)) * 16777216) +
|
---|
| 148 | (StrToInt(Piece(A, '.', 2)) * 65536) +
|
---|
| 149 | (StrToInt(Piece(A, '.', 3)) * 256) +
|
---|
| 150 | StrToInt(Piece(A, '.', 4));
|
---|
| 151 | NumB := (StrToInt(Piece(B, '.', 1)) * 16777216) +
|
---|
| 152 | (StrToInt(Piece(B, '.', 2)) * 65536) +
|
---|
| 153 | (StrToInt(Piece(B, '.', 3)) * 256) +
|
---|
| 154 | StrToInt(Piece(B, '.', 4));
|
---|
| 155 | Result := NumA - NumB;
|
---|
| 156 | end;
|
---|
| 157 |
|
---|
| 158 | procedure CopyFileDate(const Source, Dest: string);
|
---|
| 159 | { from TI2972 }
|
---|
| 160 | var
|
---|
| 161 | SourceHand, DestHand: Integer;
|
---|
| 162 | begin
|
---|
| 163 | SourceHand := FileOpen(Source, fmOutput); { open source file }
|
---|
| 164 | DestHand := FileOpen(Dest, fmInput); { open dest file }
|
---|
| 165 | FileSetDate(DestHand, FileGetDate(SourceHand)); { get/set date }
|
---|
| 166 | FileClose(SourceHand); { close source file }
|
---|
| 167 | FileClose(DestHand); { close dest file }
|
---|
| 168 | end;
|
---|
| 169 |
|
---|
| 170 | procedure CopyLastWriteTime(const Source, Dest: string);
|
---|
| 171 | var
|
---|
| 172 | HandleSrc, HandleDest: Integer;
|
---|
| 173 | LastWriteTime: TFileTime;
|
---|
| 174 | begin
|
---|
| 175 | HandleSrc := FileOpen(Source, fmOpenRead or fmShareDenyNone);
|
---|
| 176 | HandleDest := FileOpen(Dest, fmOpenWrite);
|
---|
| 177 | if (HandleSrc > 0) and (HandleDest > 0) then
|
---|
| 178 | begin
|
---|
| 179 | if GetFileTime(THandle(HandleSrc), nil, nil, @LastWriteTime) = TRUE
|
---|
| 180 | then SetFileTime(THandle(HandleDest), nil, nil, @LastWriteTime);
|
---|
| 181 | FileClose(HandleSrc);
|
---|
| 182 | FileClose(HandleDest);
|
---|
| 183 | end;
|
---|
| 184 | end;
|
---|
| 185 |
|
---|
| 186 | procedure Delay(i: Integer);
|
---|
| 187 | const
|
---|
| 188 | AMilliSecond = 0.000000011574;
|
---|
| 189 | var
|
---|
| 190 | Start: TDateTime;
|
---|
| 191 | begin
|
---|
| 192 | Start := Now;
|
---|
| 193 | while Now < (Start + (i * AMilliSecond)) do Application.ProcessMessages;
|
---|
| 194 | end;
|
---|
| 195 |
|
---|
| 196 | procedure FileCopy(const FromFileName, ToFileName: string);
|
---|
| 197 | var
|
---|
| 198 | FromFile, ToFile: file;
|
---|
| 199 | NumRead, NumWritten: Integer;
|
---|
| 200 | Buf: array[1..16384] of Char;
|
---|
| 201 | begin
|
---|
| 202 | AssignFile(FromFile, FromFileName); // Input file
|
---|
| 203 | Reset(FromFile, 1); // Record size = 1
|
---|
| 204 | AssignFile(ToFile, ToFileName); // Output file
|
---|
| 205 | Rewrite(ToFile, 1); // Record size = 1
|
---|
| 206 | repeat
|
---|
| 207 | BlockRead(FromFile, Buf, SizeOf(Buf), NumRead);
|
---|
| 208 | BlockWrite(ToFile, Buf, NumRead, NumWritten);
|
---|
| 209 | until (NumRead = 0) or (NumWritten <> NumRead);
|
---|
| 210 | CloseFile(FromFile);
|
---|
| 211 | CloseFile(ToFile);
|
---|
| 212 | end;
|
---|
| 213 |
|
---|
| 214 | procedure FileCopyWithDate(const FromFileName, ToFileName: string);
|
---|
| 215 | var
|
---|
| 216 | FileHandle, ADate: Integer;
|
---|
| 217 | begin
|
---|
| 218 | FileCopy(FromFileName, ToFileName);
|
---|
| 219 | FileHandle := FileOpen(FromFileName, fmOpenRead or fmShareDenyNone);
|
---|
| 220 | ADate := FileGetDate(FileHandle);
|
---|
| 221 | FileClose(FileHandle);
|
---|
| 222 | if ADate < 0 then Exit;
|
---|
| 223 | FileHandle := FileOpen(ToFileName, fmOpenWrite or fmShareDenyNone);
|
---|
| 224 | if FileHandle > 0 then FileSetDate(FileHandle, ADate);
|
---|
| 225 | FileClose(FileHandle);
|
---|
| 226 | end;
|
---|
| 227 |
|
---|
| 228 | procedure CopyFileWithDate(const FromFileName, ToFileName: string);
|
---|
| 229 | var
|
---|
| 230 | FileHandle, ADate: Integer;
|
---|
| 231 | begin
|
---|
| 232 | if CopyFile(PChar(FromFileName), PChar(ToFileName), False) then
|
---|
| 233 | begin
|
---|
| 234 | FileHandle := FileOpen(FromFileName, fmOpenRead or fmShareDenyNone);
|
---|
| 235 | ADate := FileGetDate(FileHandle);
|
---|
| 236 | FileClose(FileHandle);
|
---|
| 237 | if ADate < 0 then Exit;
|
---|
| 238 | FileHandle := FileOpen(ToFileName, fmOpenWrite or fmShareDenyNone);
|
---|
| 239 | if FileHandle > 0 then FileSetDate(FileHandle, ADate);
|
---|
| 240 | FileClose(FileHandle);
|
---|
| 241 | end;
|
---|
| 242 | end;
|
---|
| 243 |
|
---|
| 244 | function FullToFilePart(const AFileName: string): string;
|
---|
| 245 | var
|
---|
| 246 | DirBuf: string;
|
---|
| 247 | FilePart: PChar;
|
---|
| 248 | NameLen: DWORD;
|
---|
| 249 | begin
|
---|
| 250 | Result := '';
|
---|
| 251 | SetString(DirBuf, nil, 255);
|
---|
| 252 | NameLen := GetFullPathName(PChar(AFileName), 255, PChar(DirBuf), FilePart);
|
---|
| 253 | if NameLen > 0 then Result := FilePart;
|
---|
| 254 | end;
|
---|
| 255 |
|
---|
| 256 | function FullToPathPart(const AFileName: string): string;
|
---|
| 257 | var
|
---|
| 258 | DirBuf: string;
|
---|
| 259 | FilePart: PChar;
|
---|
| 260 | NameLen: Cardinal;
|
---|
| 261 | begin
|
---|
| 262 | Result := '';
|
---|
| 263 | SetString(DirBuf, nil, 255);
|
---|
| 264 | NameLen := GetFullPathName(PChar(AFileName), 255, PChar(DirBuf), FilePart);
|
---|
| 265 | if NameLen > 0 then Result := Copy(DirBuf, 1, NameLen - StrLen(FilePart));
|
---|
| 266 | end;
|
---|
| 267 |
|
---|
| 268 | function IsWin95Style: Boolean;
|
---|
| 269 | begin
|
---|
| 270 | Result := Lo(GetVersion) >= 4; // True = Win95 interface, otherwise old interface
|
---|
| 271 | end;
|
---|
| 272 |
|
---|
| 273 | function ParamIndex(const AName: string): Integer;
|
---|
| 274 | var
|
---|
| 275 | i: Integer;
|
---|
| 276 | x: string;
|
---|
| 277 | begin
|
---|
| 278 | Result := 0;
|
---|
| 279 | for i := 1 to ParamCount do
|
---|
| 280 | begin
|
---|
| 281 | x := UpperCase(ParamStr(i));
|
---|
| 282 | x := Piece(x, '=', 1);
|
---|
| 283 | if x = Uppercase(AName) then
|
---|
| 284 | begin
|
---|
| 285 | Result := i;
|
---|
| 286 | Break;
|
---|
| 287 | end;
|
---|
| 288 | end; {for i}
|
---|
| 289 | end;
|
---|
| 290 |
|
---|
| 291 | function ParamSearch(const AName: string): string;
|
---|
| 292 | var
|
---|
| 293 | i: Integer;
|
---|
| 294 | x: string;
|
---|
| 295 | begin
|
---|
| 296 | Result := '';
|
---|
| 297 | for i := 1 to ParamCount do
|
---|
| 298 | begin
|
---|
| 299 | x := UpperCase(ParamStr(i));
|
---|
| 300 | x := Copy(x, 1, Pos('=', x) - 1);
|
---|
| 301 | if x = Uppercase(AName) then
|
---|
| 302 | begin
|
---|
| 303 | Result := UpperCase(Copy(ParamStr(i), Length(x) + 2, Length(ParamStr(i))));
|
---|
| 304 | Break;
|
---|
| 305 | end;
|
---|
| 306 | end; {for i}
|
---|
| 307 | end;
|
---|
| 308 |
|
---|
| 309 | function QuotedExeName: string;
|
---|
| 310 | var
|
---|
| 311 | i: Integer;
|
---|
| 312 | begin
|
---|
| 313 | Result := '"' + ParamStr(0) + '"';
|
---|
| 314 | for i := 1 to ParamCount do Result := Result + ' ' + ParamStr(i);
|
---|
| 315 | end;
|
---|
| 316 |
|
---|
| 317 | function RegReadInt(const AName: string): Integer;
|
---|
| 318 | var
|
---|
| 319 | Registry: TRegistry;
|
---|
| 320 | begin
|
---|
| 321 | Result := 0;
|
---|
| 322 | Registry := TRegistry.Create;
|
---|
| 323 | try
|
---|
| 324 | Registry.RootKey := CPRS_ROOT_KEY;
|
---|
| 325 | if Registry.OpenKeyReadOnly(CPRS_SOFTWARE) and Registry.ValueExists(AName)
|
---|
| 326 | then Result := Registry.ReadInteger(AName);
|
---|
| 327 | Registry.CloseKey;
|
---|
| 328 | finally
|
---|
| 329 | Registry.Free;
|
---|
| 330 | end;
|
---|
| 331 | end;
|
---|
| 332 |
|
---|
| 333 | function RegReadStr(const AName: string): string;
|
---|
| 334 | var
|
---|
| 335 | Registry: TRegistry;
|
---|
| 336 | begin
|
---|
| 337 | Result := '';
|
---|
| 338 | Registry := TRegistry.Create;
|
---|
| 339 | try
|
---|
| 340 | Registry.RootKey := CPRS_ROOT_KEY;
|
---|
| 341 | if Registry.OpenKeyReadOnly(CPRS_SOFTWARE) and Registry.ValueExists(AName)
|
---|
| 342 | then Result := Registry.ReadString(AName);
|
---|
| 343 | Registry.CloseKey;
|
---|
| 344 | finally
|
---|
| 345 | Registry.Free;
|
---|
| 346 | end;
|
---|
| 347 | end;
|
---|
| 348 |
|
---|
| 349 | function RegReadBool(const AName: string): Boolean;
|
---|
| 350 | var
|
---|
| 351 | Registry: TRegistry;
|
---|
| 352 | begin
|
---|
| 353 | Result := False;
|
---|
| 354 | Registry := TRegistry.Create;
|
---|
| 355 | try
|
---|
| 356 | Registry.RootKey := CPRS_ROOT_KEY;
|
---|
| 357 | if Registry.OpenKeyReadOnly(CPRS_SOFTWARE) and Registry.ValueExists(AName)
|
---|
| 358 | then Result := Registry.ReadBool(AName);
|
---|
| 359 | Registry.CloseKey;
|
---|
| 360 | finally
|
---|
| 361 | Registry.Free;
|
---|
| 362 | end;
|
---|
| 363 | end;
|
---|
| 364 |
|
---|
| 365 | procedure RegWriteInt(const AName: string; AValue: Integer);
|
---|
| 366 | var
|
---|
| 367 | Registry: TRegistry;
|
---|
| 368 | begin
|
---|
| 369 | Registry := TRegistry.Create;
|
---|
| 370 | try
|
---|
| 371 | Registry.RootKey := CPRS_ROOT_KEY;
|
---|
| 372 | if Registry.OpenKey(CPRS_SOFTWARE, CREATE_KEY) then Registry.WriteInteger(AName, AValue);
|
---|
| 373 | Registry.CloseKey;
|
---|
| 374 | finally
|
---|
| 375 | Registry.Free;
|
---|
| 376 | end;
|
---|
| 377 | end;
|
---|
| 378 |
|
---|
| 379 | procedure RegWriteStr(const AName, AValue: string);
|
---|
| 380 | var
|
---|
| 381 | Registry: TRegistry;
|
---|
| 382 | begin
|
---|
| 383 | Registry := TRegistry.Create;
|
---|
| 384 | try
|
---|
| 385 | Registry.RootKey := CPRS_ROOT_KEY;
|
---|
| 386 | if Registry.OpenKey(CPRS_SOFTWARE, CREATE_KEY) then Registry.WriteString(AName, AValue);
|
---|
| 387 | Registry.CloseKey;
|
---|
| 388 | finally
|
---|
| 389 | Registry.Free;
|
---|
| 390 | end;
|
---|
| 391 | end;
|
---|
| 392 |
|
---|
| 393 | procedure RegWriteBool(const AName: string; AValue: Boolean);
|
---|
| 394 | var
|
---|
| 395 | Registry: TRegistry;
|
---|
| 396 | begin
|
---|
| 397 | Registry := TRegistry.Create;
|
---|
| 398 | try
|
---|
| 399 | Registry.RootKey := CPRS_ROOT_KEY;
|
---|
| 400 | if Registry.OpenKey(CPRS_SOFTWARE, CREATE_KEY) then Registry.WriteBool(AName, AValue);
|
---|
| 401 | Registry.CloseKey;
|
---|
| 402 | finally
|
---|
| 403 | Registry.Free;
|
---|
| 404 | end;
|
---|
| 405 | end;
|
---|
| 406 |
|
---|
| 407 | function RegKeyExists(ARoot: HKEY; const AKey: string): Boolean;
|
---|
| 408 | var
|
---|
| 409 | Registry: TRegistry;
|
---|
| 410 | begin
|
---|
| 411 | Result := False;
|
---|
| 412 | Registry := TRegistry.Create;
|
---|
| 413 | try
|
---|
| 414 | Registry.RootKey := ARoot;
|
---|
| 415 | //Result := Registry.KeyExists(AKey); {this tries to open key with full access}
|
---|
| 416 | if Registry.OpenKeyReadOnly(AKey) and (Registry.CurrentKey <> 0) then Result := True;
|
---|
| 417 | Registry.CloseKey;
|
---|
| 418 | finally
|
---|
| 419 | Registry.Free;
|
---|
| 420 | end;
|
---|
| 421 | end;
|
---|
| 422 |
|
---|
| 423 | function UserRegReadDateTime(const AKey, AName: string): TDateTime;
|
---|
| 424 | var
|
---|
| 425 | Registry: TRegistry;
|
---|
| 426 | begin
|
---|
| 427 | Result := 0;
|
---|
| 428 | Registry := TRegistry.Create;
|
---|
| 429 | try
|
---|
| 430 | Registry.RootKey := CPRS_USER_KEY;
|
---|
| 431 | if Registry.OpenKey(AKey, CREATE_KEY) and Registry.ValueExists(AName) then
|
---|
| 432 | try
|
---|
| 433 | Result := Registry.ReadDateTime(AName);
|
---|
| 434 | except
|
---|
| 435 | on ERegistryException do Result := 0;
|
---|
| 436 | end;
|
---|
| 437 | Registry.CloseKey;
|
---|
| 438 | finally
|
---|
| 439 | Registry.Free;
|
---|
| 440 | end;
|
---|
| 441 | end;
|
---|
| 442 |
|
---|
| 443 | procedure UserRegWriteDateTime(const AKey, AName: string; AValue: TDateTime);
|
---|
| 444 | var
|
---|
| 445 | Registry: TRegistry;
|
---|
| 446 | begin
|
---|
| 447 | Registry := TRegistry.Create;
|
---|
| 448 | try
|
---|
| 449 | Registry.RootKey := CPRS_USER_KEY;
|
---|
| 450 | if Registry.OpenKey(AKey, CREATE_KEY) then Registry.WriteDateTime(AName, AValue);
|
---|
| 451 | Registry.CloseKey;
|
---|
| 452 | finally
|
---|
| 453 | Registry.Free;
|
---|
| 454 | end;
|
---|
| 455 | end;
|
---|
| 456 |
|
---|
| 457 | function UserRegReadInt(const AKey, AName: string): Integer;
|
---|
| 458 | var
|
---|
| 459 | Registry: TRegistry;
|
---|
| 460 | begin
|
---|
| 461 | Result := 0;
|
---|
| 462 | Registry := TRegistry.Create;
|
---|
| 463 | try
|
---|
| 464 | Registry.RootKey := CPRS_USER_KEY;
|
---|
| 465 | if Registry.OpenKey(AKey, CREATE_KEY) and Registry.ValueExists(AName)
|
---|
| 466 | then Result := Registry.ReadInteger(AName);
|
---|
| 467 | Registry.CloseKey;
|
---|
| 468 | finally
|
---|
| 469 | Registry.Free;
|
---|
| 470 | end;
|
---|
| 471 | end;
|
---|
| 472 |
|
---|
| 473 | procedure UserRegWriteInt(const AKey, AName: string; AValue: Integer);
|
---|
| 474 | var
|
---|
| 475 | Registry: TRegistry;
|
---|
| 476 | begin
|
---|
| 477 | Registry := TRegistry.Create;
|
---|
| 478 | try
|
---|
| 479 | Registry.RootKey := CPRS_USER_KEY;
|
---|
| 480 | if Registry.OpenKey(AKey, CREATE_KEY) then Registry.WriteInteger(AName, AValue);
|
---|
| 481 | Registry.CloseKey;
|
---|
| 482 | finally
|
---|
| 483 | Registry.Free;
|
---|
| 484 | end;
|
---|
| 485 | end;
|
---|
| 486 |
|
---|
| 487 | procedure RunProgram(const AppName: string);
|
---|
| 488 | var
|
---|
| 489 | StartInfo: TStartupInfo;
|
---|
| 490 | ProcInfo: TProcessInformation;
|
---|
| 491 | begin
|
---|
| 492 | FillChar(StartInfo, SizeOf(StartInfo), 0);
|
---|
| 493 | StartInfo.CB := SizeOf(StartInfo);
|
---|
| 494 | CreateProcess(nil, PChar(AppName), nil, nil, False, DETACHED_PROCESS or NORMAL_PRIORITY_CLASS,
|
---|
| 495 | nil, nil, StartInfo, ProcInfo);
|
---|
| 496 | end;
|
---|
| 497 |
|
---|
| 498 | function UpdateSelf: Boolean;
|
---|
| 499 | var
|
---|
| 500 | CPRSUpdate: string;
|
---|
| 501 | begin
|
---|
| 502 | // auto-update if newer version available
|
---|
| 503 | Result := False;
|
---|
| 504 | CPRSUpdate := RegReadStr(CPRS_REG_GOLD) + 'CPRSUpdate.exe';
|
---|
| 505 | if not FileExists(CPRSUpdate) then CPRSUpdate := 'CPRSUpdate.exe';
|
---|
| 506 | if AppOutOfDate(Application.ExeName) and FileExists(CPRSUpdate) then
|
---|
| 507 | begin
|
---|
| 508 | Result := True;
|
---|
| 509 | RunProgram(CPRSUpdate + ' COPY=' + QuotedExeName);
|
---|
| 510 | end;
|
---|
| 511 | end;
|
---|
| 512 |
|
---|
| 513 | (*
|
---|
| 514 | procedure UpdateAppFromGold(const AppName: string);
|
---|
| 515 | var
|
---|
| 516 | GoldName: string;
|
---|
| 517 | begin
|
---|
| 518 | Delay(1500);
|
---|
| 519 | // do a rename of AppName in case problem?
|
---|
| 520 | GoldName := RegReadStr(CPRS_REG_GOLD);
|
---|
| 521 | if Length(GoldName) = 0 then Exit;
|
---|
| 522 | if GoldName[Length(GoldName)] <> '\' then GoldName := GoldName + '\';
|
---|
| 523 | GoldName := GoldName + ReverseStr(Piece(ReverseStr(AppName), '\', 1));
|
---|
| 524 | CopyFileWithDate(GoldName, AppName);
|
---|
| 525 | end;
|
---|
| 526 | *)
|
---|
| 527 |
|
---|
[829] | 528 | function BorlandDLLVersionOK: boolean;
|
---|
| 529 | const
|
---|
| 530 | DLL_CURRENT_VERSION = 10;
|
---|
| 531 | TC_DLL_ERR = 'ERROR - BORLNDMM.DLL';
|
---|
| 532 | TX_NO_RUN = 'This version of CPRS is unable to run because' + CRLF;
|
---|
| 533 | TX_NO_DLL = 'no copy of BORLNDMM.DLL can be found' + CRLF +
|
---|
| 534 | 'in your workstation''s current PATH.';
|
---|
| 535 | TX_OLD_DLL1 = 'the copy of BORLNDMM.DLL located at:' + CRLF + CRLF;
|
---|
| 536 | TX_OLD_DLL2 = CRLF + CRLF + 'is out of date (Version ';
|
---|
| 537 | TX_CALL_IRM = CRLF + CRLF +'Please contact IRM for assistance.';
|
---|
| 538 | var
|
---|
| 539 | DLLHandle: HMODULE;
|
---|
| 540 | DLLNamePath: array[0..261] of Char;
|
---|
| 541 | DLLVersion: string;
|
---|
| 542 | begin
|
---|
| 543 | Result := TRUE;
|
---|
| 544 | DLLHandle := GetModuleHandle('BORLNDMM.DLL');
|
---|
| 545 | if DLLHandle <=0 then
|
---|
| 546 | begin
|
---|
| 547 | InfoBox(TX_NO_RUN + TX_NO_DLL + TX_CALL_IRM, TC_DLL_ERR, MB_ICONERROR or MB_OK);
|
---|
| 548 | Result := FALSE;
|
---|
| 549 | Exit;
|
---|
| 550 | end;
|
---|
| 551 | Windows.GetModuleFileName(DLLHandle, DLLNamePath, 261);
|
---|
| 552 | DLLVersion := ClientVersion(DLLNamePath);
|
---|
| 553 | if StrToIntDef(Piece(DLLVersion, '.', 1), 0) < DLL_CURRENT_VERSION then
|
---|
| 554 | begin
|
---|
| 555 | InfoBox(TX_NO_RUN + TX_OLD_DLL1 + ' ' + DLLNamePath + TX_OLD_DLL2 + DLLVersion + ')' +
|
---|
| 556 | TX_CALL_IRM, TC_DLL_ERR, MB_ICONERROR or MB_OK);
|
---|
| 557 | Result := false;
|
---|
| 558 | end;
|
---|
| 559 | end;
|
---|
| 560 |
|
---|
[456] | 561 | end.
|
---|