RAD Studio VCS Info
Check-in [6af77a0ede]
Login
HomeTimelineBranchesTagsTicketsWiki

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Make icon retrieval more robust. Always fetch the small icon. Reduce the timeout to 10 seconds.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:6af77a0ede4663e1bf521192ebe61df2835d89dd
User & Date: tinus 2015-11-21 01:25:11
Context
2015-11-21
01:46
Use ExtractIcon to read an executable's icon. check-in: 7af134b435 user: tinus tags: trunk
01:25
Make icon retrieval more robust. Always fetch the small icon. Reduce the timeout to 10 seconds. check-in: 6af77a0ede user: tinus tags: trunk
01:11
Tried moving the version number to a central option set. Added version info. check-in: deb518e572 user: tinus tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to src/Delphi10/VCSInfo.dproj. 

197
198
199
200
201
202
203
204









205
206
207
208
209
210
211
...
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534

                </DeployFile>
                <DeployFile LocalName="C:\Users\Public\Documents\Embarcadero\Studio\15.0\Bpl\VCSInfo.bpl" Configuration="Debug" Class="ProjectOutput">
                    <Platform Name="Win32">
                        <RemoteName>VCSInfo.bpl</RemoteName>
                        <Overwrite>true</Overwrite>
                    </Platform>
                </DeployFile>
                <DeployClass Name="ProjectiOSDeviceResourceRules"/>









                <DeployClass Name="ProjectOSXResource">
                    <Platform Name="OSX32">
                        <RemoteDir>Contents\Resources</RemoteDir>
                        <Operation>1</Operation>
                    </Platform>
                </DeployClass>
                <DeployClass Name="AndroidClassesDexFile">
................................................................................
                </DeployClass>
                <DeployClass Name="Android_LauncherIcon36">
                    <Platform Name="Android">
                        <RemoteDir>res\drawable-ldpi</RemoteDir>
                        <Operation>1</Operation>
                    </Platform>
                </DeployClass>
                <DeployClass Name="DependencyModule">
                    <Platform Name="Win32">
                        <Operation>0</Operation>
                        <Extensions>.dll;.bpl</Extensions>
                    </Platform>
                    <Platform Name="OSX32">
                        <Operation>1</Operation>
                        <Extensions>.dylib</Extensions>
                    </Platform>
                </DeployClass>
                <ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
                <ProjectRoot Platform="iOSDevice64" Name="$(PROJECTNAME).app"/>
                <ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>
                <ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
                <ProjectRoot Platform="OSX32" Name="$(PROJECTNAME)"/>
                <ProjectRoot Platform="Android" Name="$(PROJECTNAME)"/>
                <ProjectRoot Platform="iOSSimulator" Name="$(PROJECTNAME).app"/>








|
>
>
>
>
>
>
>
>
>







 







|
<
<
<
<
<
<
<
<
<








197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
...
520
521
522
523
524
525
526
527









528
529
530
531
532
533
534

                </DeployFile>
                <DeployFile LocalName="C:\Users\Public\Documents\Embarcadero\Studio\15.0\Bpl\VCSInfo.bpl" Configuration="Debug" Class="ProjectOutput">
                    <Platform Name="Win32">
                        <RemoteName>VCSInfo.bpl</RemoteName>
                        <Overwrite>true</Overwrite>
                    </Platform>
                </DeployFile>
                <DeployClass Name="DependencyModule">
                    <Platform Name="Win32">
                        <Operation>0</Operation>
                        <Extensions>.dll;.bpl</Extensions>
                    </Platform>
                    <Platform Name="OSX32">
                        <Operation>1</Operation>
                        <Extensions>.dylib</Extensions>
                    </Platform>
                </DeployClass>
                <DeployClass Name="ProjectOSXResource">
                    <Platform Name="OSX32">
                        <RemoteDir>Contents\Resources</RemoteDir>
                        <Operation>1</Operation>
                    </Platform>
                </DeployClass>
                <DeployClass Name="AndroidClassesDexFile">
................................................................................
                </DeployClass>
                <DeployClass Name="Android_LauncherIcon36">
                    <Platform Name="Android">
                        <RemoteDir>res\drawable-ldpi</RemoteDir>
                        <Operation>1</Operation>
                    </Platform>
                </DeployClass>
                <DeployClass Name="ProjectiOSDeviceResourceRules"/>









                <ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
                <ProjectRoot Platform="iOSDevice64" Name="$(PROJECTNAME).app"/>
                <ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>
                <ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
                <ProjectRoot Platform="OSX32" Name="$(PROJECTNAME)"/>
                <ProjectRoot Platform="Android" Name="$(PROJECTNAME)"/>
                <ProjectRoot Platform="iOSSimulator" Name="$(PROJECTNAME).app"/>

Changes to src/VCSInfoMenuWzrd.pas. 

364
365
366
367
368
369
370
371
372

373
374
375
376
377
378
379
...
426
427
428
429
430
431
432

433
434
435
436
437
438
439
440
441
442
443

444
445
446


447
448
449
450
451
452
453
....
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165

                                            PChar(ACurrentDir),
                                            SUI, ProcInfo);
  except
    Result := False;
  end;
end {CreateProcess};

// http://stackoverflow.com/a/1720501/3092116
function GetCurrentVersion(): string;

var
  verblock: PVSFixedFileInfo;
  versionMS, versionLS: cardinal;
  verlen: cardinal;
  rs: TResourceStream;
  m: TMemoryStream;
  p: pointer;
................................................................................
    Result := Services.AddMasked(bmp, bmp.TransparentColor);
  end;
  { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
  function AddExeIcon(const ExeName: string): Integer;
  var
    ExePath: string;
    PFileName: PChar;

    Icon: TIcon;
    FileInfo: TSHFileInfo;
  begin
    Icon := TIcon.Create;
    try
      ExePath := StringOfChar(#0, 255);
      SetLength(ExePath, SearchPath(nil, PChar(ExeName), nil, Length(ExePath), PChar(ExePath), PFileName));
      if ExePath <> '' then begin
        FileInfo := Default(TSHFileInfo);
        SHGetFileInfo(PChar(ExePath), 0, FileInfo, SizeOf(FileInfo), SHGFI_ICON);
        Icon.Handle := FileInfo.hIcon;

      end else begin
        Icon.Handle := LoadIcon(0, IDI_APPLICATION);
      end;


      Result := Services.ImageList.AddIcon(Icon);
    finally
      Icon.Free;
    end;
  end {AddExeIcon};
  { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
  function AddButtonMenuItem(const Button: TToolButton; ImageIndex: integer; Caption: string): TMenuItem;
................................................................................
    Result := Default(TRepoInfo);
  end;
end {TVCSInfoWizard.GetProjectRepo};

{ ------------------------------------------------------------------------------------------------ }
function TVCSInfoWizard.GetRepoInfo(const AFileName: string; const AForceUpdate: Boolean): TRepoInfo;
const
  cRefreshSeconds = 15;
var
  FilePath, FinalFilePath, RootPath, FinalRootPath: string;
  Lines: TStringList;
  Line: string;
  iRes: Cardinal;
begin
  Result := Default(TRepoInfo);








<

>







 







>



|
<
|
|
|
|
|
|
>
|
|
|
>
>







 







|








364
365
366
367
368
369
370

371
372
373
374
375
376
377
378
379
...
426
427
428
429
430
431
432
433
434
435
436
437

438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
....
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168

                                            PChar(ACurrentDir),
                                            SUI, ProcInfo);
  except
    Result := False;
  end;
end {CreateProcess};


function GetCurrentVersion(): string;
// http://stackoverflow.com/a/1720501/3092116
var
  verblock: PVSFixedFileInfo;
  versionMS, versionLS: cardinal;
  verlen: cardinal;
  rs: TResourceStream;
  m: TMemoryStream;
  p: pointer;
................................................................................
    Result := Services.AddMasked(bmp, bmp.TransparentColor);
  end;
  { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
  function AddExeIcon(const ExeName: string): Integer;
  var
    ExePath: string;
    PFileName: PChar;
    IconHandle: HICON;
    Icon: TIcon;
    FileInfo: TSHFileInfo;
  begin
    IconHandle := 0;

    ExePath := StringOfChar(#0, 255);
    SetLength(ExePath, SearchPath(nil, PChar(ExeName), nil, Length(ExePath), PChar(ExePath), PFileName));
    if ExePath <> '' then begin
      FileInfo := Default(TSHFileInfo);
      if SHGetFileInfo(PChar(ExePath), 0, FileInfo, SizeOf(FileInfo), SHGFI_ICON or SHGFI_SMALLICON) <> 0 then
        IconHandle := FileInfo.hIcon;
    end;
    if IconHandle = 0 then
      IconHandle := LoadIcon(0, IDI_APPLICATION);
    Icon := TIcon.Create;
    try
      Icon.Handle := IconHandle;
      Result := Services.ImageList.AddIcon(Icon);
    finally
      Icon.Free;
    end;
  end {AddExeIcon};
  { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
  function AddButtonMenuItem(const Button: TToolButton; ImageIndex: integer; Caption: string): TMenuItem;
................................................................................
    Result := Default(TRepoInfo);
  end;
end {TVCSInfoWizard.GetProjectRepo};

{ ------------------------------------------------------------------------------------------------ }
function TVCSInfoWizard.GetRepoInfo(const AFileName: string; const AForceUpdate: Boolean): TRepoInfo;
const
  cRefreshSeconds = 10;
var
  FilePath, FinalFilePath, RootPath, FinalRootPath: string;
  Lines: TStringList;
  Line: string;
  iRes: Cardinal;
begin
  Result := Default(TRepoInfo);

Powered by Fossil · RSS · Site map