1

まあ、私は困惑しています。いくつかのコンポーネントをインストールする Smart Install Maker 用のインストール サポート アドオンを作成しています - AlphaControls :)

アドオンはコンソール アプリケーションです。しかし、何らかの理由で [コードの下に] 「既知のパッケージ」レジストリの場所にパッケージを追加するために、配列サイズが 3 にしか設定されていないにもかかわらず、追加のレジストリ エントリを追加する必要があります。.DPK ファイルを追加しようとしています。 、アレイが .BPL 用にセットアップされている場合でも。すぅ…なんだよ???? 追加しようとする最後のしつこいビットを除いて、それはすべて機能します。コンパイル サイズは約 97/98k で、最適化および圧縮後は約 48k に縮小されます

だから私の質問は、私が見落としているように見えるエラーを誰かが見つけることができるでしょうか? はい、知っています - INNO SETUP ですが... Smart Install Maker にすでにお金を使っているので、それを使用する必要があります。
コンパイル エラーは発生せず、余分な非 .bpl ファイルをレジストリに追加するだけです

コードは次のとおりです...

{Smart Install Maker installation support for components}
{for Delphi 7.0 environment only}
program pakghlp;

{$APPTYPE CONSOLE}

uses
  Windows,
  SysUtils,
  Classes,
  Registry;

var  SPath,
   BPLPath,
   IDERoot,
   DPKName: string;

const
 BaseName = 'AlphaControls';

 PackageRoot = 'AlphaControls\';

 DPKFiles: array[1..5]
  of string = ('acntD7_R.dpk',
               'acntD7.dpk',
               'aceD7_R.dpk',
               'aceD7.dpk',
               'AlphaDB7.dpk');

 DPKArraySize = 5;

 BPLFiles: array[1..3]
 of string = ('aceD7.bpl',
              'acntD7.bpl',
              'AlphaDB7.bpl');

 BPLDetails: array[1..3]
 of string = ('AlphaControls extra',
              'AlphaControls',
              'AlphaControls DB-aware pack');

 BPLFileQty = 3;

  LookFor: array[1..2] of string = ('*.dcp','*.bpl');
  LookForQty = 2;

  RegPath = ';$(DELPHI)\Components\AlphaControls';

procedure InitVariables;
var
    RegKey: TRegistry;
 TargetKey: string;
   LibPath: string;
begin
 RegKey:= TRegistry.Create;
   try
     RegKey.RootKey := HKEY_CURRENT_USER;
     TargetKey:= 'Software\Borland\Delphi\7.0';
     if RegKey.OpenKeyReadOnly(TargetKey) then
       begin
        IDERoot:= RegKey.ReadString('RootDir');
        RegKey.CloseKey;

        TargetKey:= 'Software\Borland\Delphi\7.0\Library';
        RegKey.OpenKeyReadOnly(TargetKey);
        SPath:= RegKey.ReadString('Search Path');
        LibPath:= RegKey.ReadString('Package DPL Output');
        RegKey.CloseKey;

        LibPath:= StringReplace(LibPath,'$(DELPHI)','',[rfIgnoreCase]);
        BPLPath:= IDERoot + LibPath + '\';
       end;
    finally
     RegKey.Free;
    end;
end;

procedure GetListing(const SearchFor: String; ImportList:TStringList);
var SrchResult : TSearchRec;
begin
if FindFirst(SearchFor, faAnyFile, SrchResult) = 0 then
  begin
    repeat
     ImportList.Add(SrchResult.name);
    until FindNext(SrchResult) <> 0;
    FindClose(SrchResult);
  end;
end;

procedure GetBaseNames(Listing: TStringList);
var TempList: TStringList;
           i: integer;
    BaseName: string;
begin
  TempList:= TStringList.Create;
  TempList.Delimiter:= ';';
  TempList.DelimitedText:= SPath;
  Listing.Clear;
  for i:= 0 to TempList.Count - 1 do
    begin
    BaseName:= TempList[i];
    StringReplace(BaseName,'$(DELPHI)','X:\Dummy\Folder',[rfIgnoreCase]);
    Listing.Add(ExtractFileName(BaseName));
    end;
  TempList.Free;
end;

function AlreadyExists: boolean;
var CheckList: TStringList;
            i: integer;
    Installed: boolean;
begin
  CheckList:= TStringList.Create;
  GetBaseNames(CheckList);

  for i:= 0 to CheckList.Count -1 do
   begin
     if CheckList[i] = BaseName
      then Installed:= true;
       if Installed = true then break;
     Installed:= false;
   end;
CheckList.Free;
Result:= Installed;
end;

procedure ProcessIDE(InstallType: integer);
var RegKey: TRegistry;
  TempList: TStringList;
       i,j: integer;
  NewSPath,
  RegName,
  RegValue,
  DelEntry: string;
begin
RegKey:= TRegistry.Create;
  case InstallType of

    0:  begin {-uninstall}
         TempList:= TStringList.Create;
         TempList.Delimiter:= ';';
         TempList.DelimitedText:= SPath;
         DelEntry:= copy(RegPath,2,Length(RegPath));
         for i:= 0 to TempList.Count - 1 do
          begin
            if TempList[i] = DelEntry
            then
             begin
              Templist.BeginUpdate;
              Templist.Delete(i);
              TempList.EndUpdate;
             end;
          end;
          NewSPath:= TempList.DelimitedText;
          try
            RegKey.RootKey:= HKEY_CURRENT_USER;
            RegKey.OpenKey('Software\Borland\Delphi\7.0\Library',false);
            RegKey.WriteString('Search Path',NewSPath);
            RegKey.CloseKey;

            RegKey.OpenKey('Software\Borland\Delphi\7.0\Known Packages',false);
            for i:= 0 to BPLFileQty do
              begin
                RegName:= BPLPath + BPLFiles[i];
                RegKey.DeleteValue(RegName);
              end;
          finally
            RegKey.CloseKey;
          end;
         TempList.Free;
        end;

    1:  begin {-install}
          SPath:= SPath + RegPath;
          try
            RegKey.RootKey:= HKEY_CURRENT_USER;
            RegKey.OpenKey('Software\Borland\Delphi\7.0\Library',false);
            RegKey.WriteString('Search Path',SPath);
            RegKey.CloseKey;

            RegKey.OpenKey('Software\Borland\Delphi\7.0\Known Packages',false);
            for j:= 0 to BPLFileQty do
              begin
                RegName:= BPLPath + BPLFiles[j];
                RegValue:= BPLDetails[j];
                RegKey.WriteString(RegName,RegValue);
              end;
          finally
          RegKey.CloseKey;
          end;
        end;
  end;
RegKey.Free;
end;

procedure CompilePackage(PackageName: String; Wait: Boolean);
var
  StartInfo : TStartupInfo;
  ProcInfo : TProcessInformation;
  CreateOK : Boolean;
begin
  FillChar(StartInfo,SizeOf(TStartupInfo),#0);
  FillChar(ProcInfo,SizeOf(TProcessInformation),#0);
  StartInfo.cb := SizeOf(TStartupInfo);
  CreateOK := CreateProcess(nil, PChar(PackageName), nil, nil,False,
              CREATE_NEW_PROCESS_GROUP+NORMAL_PRIORITY_CLASS,
              nil, nil, StartInfo, ProcInfo);
  if CreateOK then
    begin
      if Wait then
        WaitForSingleObject(ProcInfo.hProcess, INFINITE);
    end
  else
    begin
      WriteLN('Unable to compile: ' + DPKName);
     end;
  CloseHandle(ProcInfo.hProcess);
  CloseHandle(ProcInfo.hThread);
end;

procedure ProcessPackages;
var Package: string;
          i: integer;
const DCC32 = 'DCC32 ';
begin
  for i:= 1 to DPKArraySize do
  begin
    DPKName:= ExpandFileName(GetCurrentDir + '\..')
            + '\' + PackageRoot + DPKFiles[i];
    Package:= DCC32 + '"' + DPKName + '"';
    CompilePackage(Package,true);
    Sleep(500);
  end;
end;

procedure ProcessFiles(InstallType: integer);
var TempList: TStringList;
    MoveList: TextFile;
         i,j: integer;
    FileFrom,
      FileTo,
   ParentDir,
  SearchType: string;
begin
  case InstallType of

    0:  begin {-uninstall}
          AssignFile(MoveList,'pakghlp.dat');
          Reset(MoveList);
            while not eof(MoveList) do
              begin
                readLn(MoveList,FileFrom);
                if FileExists(FileFrom)
                then DeleteFile(PChar(FileFrom));
              end;
          CloseFile(MoveList);
          DeleteFile(PChar('pakghlp.dat'));
        end;

    1:  begin {-install}
        ProcessPackages;
          if FileExists('pakghlp.dat') then DeleteFile(PChar('pakghlp.dat'));
           AssignFile(MoveList,'pakghlp.dat');
           Rewrite(MoveList);
           ParentDir:= ExpandFileName(GetCurrentDir + '\..') + '\';
           TempList:= TStringList.Create;
          for i:= 1 to LookForQty do // file extension types
            begin
              SearchType:= ParentDir + PackageRoot + LookFor[i];
              GetListing(SearchType,TempList);
              for j:= 0 to Templist.Count - 1 do
                begin
                  FileFrom:= ParentDir + PackageRoot + TempList[j];
                  FileTo:= BPLPath + TempList[j];
                  CopyFile(PChar(FileFrom),PChar(FileTo),False);
                  DeleteFile(PChar(FileFrom));
                  WriteLn(MoveList,FileTo);
                end;
            end;
          CloseFile(MoveList);
        end;
  end;
TempList.Free;
end;

procedure InstallComponents;
begin
  InitVariables;
  if AlreadyExists then ProcessFiles(1) // refresh corrupt .dcu's.
  else
    begin // didn't previously exist
      ProcessFiles(1);
      ProcessIDE(1);
    end;
end;

procedure RemoveComponents;
begin
  InitVariables;
  ProcessFiles(0);
  ProcessIDE(0);
end;

{ ----- Console Application Begins Here ------- }
begin
  if ParamCount =  0 then exit;

  if ParamStr(1) = '-install'
    then InstallComponents;

  if ParamStr(1) = '-uninstall'
    then RemoveComponents

  else exit; // garbage trap
end.
4

1 に答える 1

1

BPLFiles 配列を反復処理するために使用されるインデックスに関連しているようです。これは 1 インデックス ベースで、0 インデックス ベースを使用しています。

const
     BPLFiles: array[1..3]
     of string = ('aceD7.bpl',
                  'acntD7.bpl',
                  'AlphaDB7.bpl');

このコードを変更

for i:= 0 to BPLFileQty do
    begin
      RegName:= BPLPath + BPLFiles[i];
      RegKey.DeleteValue(RegName);
    end;

に

for i:= 1 to BPLFileQty do
    begin
      RegName:= BPLPath + BPLFiles[i];
      RegKey.DeleteValue(RegName);
    end;

そして、このコード

        for j:= 0 to BPLFileQty do
          begin
            RegName:= BPLPath + BPLFiles[j];
            RegValue:= BPLDetails[j];
            RegKey.WriteString(RegName,RegValue);
          end;

に

        for j:= 1 to BPLFileQty do
          begin
            RegName:= BPLPath + BPLFiles[j];
            RegValue:= BPLDetails[j];
            RegKey.WriteString(RegName,RegValue);
          end;
于 2012-06-25T15:25:42.260 に答える