delphi获取程序版本的实现标准getVersion

admin

首先在XC的看板程序上验证：


function TDataModule2.getVersion(myappname: string): string;
var
   TransBuffer,syant_buffer,VersionPointer: pchar;
   Translen, dump,size,vallen: UInt;
   Temp: integer;
   CalcLangCharSet,FLangCharSet:string;
   current_version:string;
begin
     result:='0.0.0.2';
     size := GetFileVersionInfoSize(pchar(myappname), dump);
     if  size <> 0 then
     begin
          syant_buffer := StrAlloc(size+1);
          try
                if not GetFileVersionInfo(Pchar(myappname), 0, size, syant_buffer) then
                begin
                    result:='0.0.0.3';
                end  else
                begin
                      VerQueryValue(syant_buffer, '\VarFileInfo\Translation',  pointer(TransBuffer), TransLen);
                      if TransLen >= 4 then
                      begin
                          temp:=0; // fix bug by syant 2019/04/04   win1064 or win7 sometimes get (400)0804 (400)03A8
                          StrLCopy(@temp, TransBuffer, 2);
                          CalcLangCharSet:=IntToHex(temp, 4);
                          temp:=0;  // fix bug by syant 2019/04/04   win1064 or win7 sometimes get (400)0804 (400)03A8
                          StrLCopy(@temp, TransBuffer+2, 2);
                          CalcLangCharSet := CalcLangCharSet+IntToHex(temp, 4);
                          FLangCharSet := CalcLangCharSet;  //the right data = 080403A8
                          //
                          if VerQueryValue(syant_buffer, pchar('\StringFileInfo\'+FLangCharSet+'\'+
                                   'FileVersion'),
                                   pointer(VersionPointer), vallen) then
                          begin
                              if (Vallen > 1) then
                              begin
                                  SetLength(current_version, vallen);
                                  StrLCopy(Pchar(current_version), VersionPointer, vallen);
                                  result:=trim(current_version);
                              end else
                              begin
                                result:='0.0.0.4';
                              end;
                          end else
                          begin
                              result:='0.0.0.5';
                          end;
                      end  else
                      begin
                          result:='0.0.0.6';
                      end;
                end;
            finally
                StrDispose(syant_buffer);
            end;
     end;
end;