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

Posted

技术标签:

【中文标题】Delphi 组件安装实用程序控制台应用程序【英文标题】:Delphi components install utility console application 【发布时间】:2012-06-26 14:49:58 【问题描述】:

好吧,我很难过。 我正在为 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.

【问题讨论】:

你已经屈服于“沉没成本”的谬误。你在某件事上花钱了,你认为这迫使你使用它,但无论你是否使用它,这笔钱都消失了!您可以在不花任何额外费用的情况下获得更好的工具,那么谁在乎您在劣质产品上花了多少钱?假装你把它花在了免费产品上,如果这让你感觉更好的话。 【参考方案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;

【讨论】:

都该死。我必须至少看了十几次那个部分,它正盯着我看。哈哈。我改变了它,现在它工作得很好。其他一些事情[上面未显示]也得到了修复。至于谬误,是的,我猜你是对的。但是由于您的帮助,它现在工作得很好,我保留了它。

以上是关于Delphi 组件安装实用程序控制台应用程序的主要内容,如果未能解决你的问题,请参考以下文章

推荐颜色选择器实用程序,支持Delphi颜色代码[关闭]

dos命令之window10程序控制命令

delphi VCL组件同名继承

便携式开放式办公室可以在我的机器上不安装开放式办公室的情况下执行此文件转换实用程序吗

v远p程s桌面robots管理程序下载安装

监控 Delphi 应用程序执行的 SQL 查询