PureBasic Forums - English

Code: Select all

type
  VS_VERSIONINFO = packed record
    wLength: Word;
    wValueLength: Word;
    wType: Word;
    szKey: array [0..15] of WideChar;
    Padding1: Word;
    Value: VS_FIXEDFILEINFO;
    Padding2: Word;
    Children: Word;
  end;



  function MakeLangID( p, s: Word): WORD;
  begin
    Result := (s shl 10) or p;

  end;

function SetFileVersion( const AFileName: string;
                         Major,Minor, Release, Build: Word ): Boolean;
var
  lHLib: Cardinal;
  lHRes: Cardinal;
  lHResLoad: Cardinal;
  lPResLock: Pointer;
  lSz: Cardinal;
  lFS: TFileStream;
  //
  lPVersionInfo: ^VS_VERSIONINFO;
  lFV: ^TFileVer;
  //lPFixedFileInfo: ^VS_FIXEDFILEINFO;
  lPt: Pointer;
  lVer: string;
  lVarFileInfo:

  lHResUpd: Cardinal;
  lDiscard: Boolean;

begin
  Result := False;
  if not FileExists( AFileName ) then Exit;
  lHLib := LoadLibrary( PChar(AFileName) );
  if lHLib = 0 then Exit;
  try
    lHRes := FindResource( lHLib, MakeIntResource(1), RT_VERSION );
    if lHRes = 0 then Exit;
    lHResLoad := LoadResource( lHLib, lHRes );
    lSz := SizeofResource( lHLib, lHRes );
    if lHResLoad = 0 then Exit;
    lPResLock := LockResource( lHResLoad );
    GetMem( lPt, lSz );
    Move( lPResLock^, lPt^, lSz );
  finally
    FreeLibrary( lHLib );
  end;

  try
    lPVersionInfo := lPt;
    lPVersionInfo^.Value.dwFileVersionMS := (Major shl 16) or (Minor);
    lPVersionInfo^.Value.dwFileVersionLS := (Release shl 16) or (Build);
    lPVersionInfo^.Value.dwProductVersionMS := lPVersionInfo^.Value.dwFileVersionMS;
    lPVersionInfo^.Value.dwProductVersionLS := lPVersionInfo^.Value.dwFileVersionLS;

    lHResUpd := BeginUpdateResource( PChar( AFileName ), False );
    if lHResUpd = 0 then Exit;
    lDiscard := True;
    try
      lDiscard := not UpdateResource( lHResUpd, RT_VERSION, MakeIntResource(1), 0, lPt, lSz );
    finally
      EndUpdateResource( lHResUpd, lDiscard );
    end;
  finally
    FreeMem( lPt );
  end;
end;

Code: Select all

hResource = BeginUpdateResource_("Exe.exe", #True);
#RT_VERSION = 16
If hResource = #Null
 Debug "could Not open file"
EndIf

Structure VERSIONINFO
EndStructure

Procedure MAKELANGID(primary, sublang)
 ProcedureReturn (((sublang)<<10)|(primary))
EndProcedure

Procedure.s MAKEINTRESOURCE(int)
 ProcedureReturn "#" + Str(int)
EndProcedure

If ReadFile(0,"Resource.rc")
 l = Lof(0)
 *a = AllocateMemory(l)
 ReadData(0,*a,l)
 CloseFile(0)
Else
 Debug "asdsadasdASD"
EndIf

Result = UpdateResource_(hResource, #RT_VERSION,"",MAKELANGID(#LANG_NEUTRAL,#SUBLANG_NEUTRAL),"alex",32)
If Result = 0
 Debug "UpdateResource Failed"
EndIf
Result = EndUpdateResource_(hResource, #False);

If Result = 0
 Debug "EndUpdateResource Failed"
EndIf

Code: Select all

#RT_VERSION = 16

Structure VS_VERSIONINFO
  wLength.w
  wValueLength.w
  wType.w
  szKey.w[16]
  Padding1.w
  Value.VS_FIXEDFILEINFO
  Padding2.w
  Children.w
EndStructure

Procedure.w MakeLangID(p.w, s.w)
  ProcedureReturn (s << 10) | p
EndProcedure

Macro MAKEINTRESOURCE(I)
  (I)
EndMacro

Procedure.l SetFileVersion(AFileName.s, Major.w, Minor.w, Release.w, Build.w)
  Protected lHLib.l, lHRes.l, lHResLoad.l, lPResLock.l
  Protected lSz.l
  Protected lFS.l
  Protected *lpVersionInfo.VS_VERSIONINFO
  Protected *lFV.l ; TFileVer
  Protected lPt.l
  Protected lVer.s
  Protected lVarFileInfo ; Unknown type
  Protected lHResUpd.l
  Protected lDiscard.l
  Protected Result.l
  Result = 0
  If FileSize(AFileName) < 0
    ProcedureReturn Result
  EndIf
  lHLib = LoadLibrary_(AFileName)
  If lHLib = 0
    ProcedureReturn Result
  EndIf
  lHRes = FindResource_(lHlib, MAKEINTRESOURCE(1), #RT_VERSION)
  If lHRes = 0
    FreeLibrary_(lHLib)
    ProcedureReturn Result
  EndIf
  lHResLoad = LoadResource_(lHLib, lHRes)
  lSz = SizeofResource_(lHLib, lHRes)
  If lHResLoad = 0
    FreeLibrary_(lHLib)
    ProcedureReturn Result
  EndIf
  LPResLock = LockResource_(lHResLoad)
  lPt = AllocateMemory(lSz)
  MoveMemory(lPResLock, lPt, lSz)
  FreeLibrary_(lHLib)
  
  *lpVersionInfo = lPt
  With *lpVersionInfo\Value
    \dwFileVersionMS = (Major << 16) | Minor
    \dwFileVersionLS = (Release << 16) | Build
    \dwProductVersionMS = \dwFileVersionMS
    \dwProductVersionLS = \dwFileVersionLS
  EndWith
  lHResUpd = BeginUpdateResource_(AFilename, 0)
  If lHResUpd = 0
    Goto Except
  EndIf
  lDiscard = 1
  lDiscard = -UpdateResource_(lHResUpd, #RT_VERSION, MAKEINTRESOURCE(1), 0, lPt, lSz) + 1
  EndUpdateResource_(lHResUpd, lDiscard)
  Except:
  FreeMemory(lPt)
EndProcedure