Question

好吧，我很难过。我正在为Smart Install Maker编写一个安装支持插件，它将为我安装一些组件 - AlphaControls：）

附加组件是一个控制台应用程序。但由于某些原因[在代码中]将包添加到“已知包”注册表位置，它想要添加一个额外的注册表项，即使数组大小仅设置为3.它正在尝试添加.DPK文件，即使数组是为.BPL设置的。哎哟......到底是怎么回事？它可以工作，除了它试图添加的最后一个唠叨位。编译后的大小约为97 / 98k，经过优化和压缩后缩小到约48k

所以我想我的问题是，有人能发现我似乎忽视的错误吗？是的，我知道设置，但是......我已经把钱花在了Smart Install Maker上，所以我必须使用它。
没有编译错误，justs将额外的非.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.

Answer 1

您发出它似乎与用于迭代BPLFiles数组的索引相关。这是一个基于索引的，你使用的是基于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;

Delphi组件安装实用程序控制台应用程

1 个答案: