lvsb.dll

library lvsb;

uses
  SysUtils, Windows, Dialogs, Classes;

{$R *.res}

var

//jump over LIsb check
PatchReload_First : Array[0..0] of byte = ($EB);

PatchReload_Second : Array[0..130] of byte =
($FF,$75,$24, //push [ebp+24]
$FF,$75,$20, //push [ebp+20]
$FF,$75,$1C, //push [ebp+1C]
$50, //push EAX
$FF,$15,$90,$90,$90,$90, //call @ProcessExternal
$89,$C2, //mov EDX,EAX
$58, //pop EAX
$83,$C4,$0C, //add ESP, 0C
$85,$D2, //test EDX,EDX
$74,$7C, //je short 163811B
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90
);
PatchReload_ForSave : Array[0..73] of byte =
($FF,$75,$18, //push [ebp+18] (arg5)
$FF,$75,$14, //push [ebp+14] (arg4)
$FF,$75,$10, //push [ebp+10] (arg3)
$FF,$75,$0C, //push [ebp+0C] (arg2)
$FF,$75,$08, //push [ebp+08] (arg1)
$FF,$15,$90,$90,$90,$90, //call @SaveCIN
$89,$C2, //mov EDX,EAX
$83,$C4,$14, //add ESP, 14
$85,$D2, //test EDX,EDX
$75,$31, //jne short 103bbe2
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90
);
PatchReload_Second_RTE : Array[0..101] of byte =
($FF,$75,$24, //push [ebp+24]
$FF,$75,$20, //push [ebp+20]
$FF,$75,$1C, //push [ebp+1C]
$50, //push EAX
$FF,$15,$90,$90,$90,$90, //call @ProcessExternal
$89,$C2, //mov EDX,EAX
$58, //pop EAX
$83,$C4,$0C, //add ESP, 0C
$85,$D2, //test EDX,EDX
$75,$C9, //jne short UP
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90
);
PatchReload_ForPurge : Array[0..24] of byte =
($51, //push ECX (arg2)
$8B,$10, //mov EDX, dword ptr ds:[EAX]
$8B,$C8, //mov ECX, EAX
$8B,$42,$1C, //mov EAX, dword ptr ds:[EDX+1C]
$FF,$D0, //call EAX
$50, //push EAX (arg1)
//$8B,$8E,$C0,$00,$00,$00, //mov ECX,dword ptr ds:[ESI+C0]
//$8B,$8D,$A0,$00,$00,$00, //mov ECX,dword ptr ds:[EBP+A0]
//$51, //push ECX (arg1)
$FF,$15,$90,$90,$90,$90, //call @PurgeCIN
//$83,$C4,$10, //add ESP,10
$83,$C4,$0C, //add ESP,C
$5E, //pop ESI
$8B,$E5, //mov ESP, EBP
$5D, //pop EBP
$C3 //retn
{
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90   }
);
PatchReload_ForPurge2 : Array[0..3] of byte =
($90,$90,$90,$90); //jne LV.01637C4B insted of LV.01637CF8
{
PatchReload_ForPurge_RTE : Array[0..181] of byte = //181
($51, //push ECX (arg2)
$8B,$10, //mov EDX, dword ptr ds:[EAX]
$8B,$C8, //mov ECX, EAX
$8B,$42,$1C, //mov EAX, dword ptr ds:[EDX+1C]
$FF,$D0, //call EAX
$50, //push EAX (arg1)
//$8B,$8E,$C0,$00,$00,$00, //mov ECX,dword ptr ds:[ESI+C0]
//$8B,$8D,$A0,$00,$00,$00, //mov ECX,dword ptr ds:[EBP+A0]
//$51, //push ECX (arg1)
$FF,$15,$90,$90,$90,$90, //call @PurgeCIN
//$83,$C4,$10, //add ESP,10
$83,$C4,$0C, //add ESP,C
//$5E, //pop ESI
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90
);         }
//Backup arrays
Backup_First : Array[0..0] of byte;
Backup_Second : Array[0..130] of byte;
Backup_ForSave : Array[0..73] of byte;
Backup_Second_RTE : Array[0..101] of byte;
//Backup_ForPurge : Array[0..203] of byte;
Backup_ForPurge : Array[0..24] of byte;
Backup_ForPurge2 : Array[0..3] of byte;
//Backup_ForPurge_RTE : Array[0..181] of byte;
ProcessExternalAddress, SaveCINAddress, PurgeCINAddress: pointer;
LVInstance, LVRTTable, mgcore: cardinal;
DbgPrintf: function (str: pchar): integer; cdecl;
DbgPrintf_Format: function (format: pchar; var1: cardinal): integer; cdecl;
DbgPrintf_PStr: function (format: pchar; var1: PShortString): integer; cdecl;
MoveBlock: procedure (source: pointer; dest: pointer; size: integer); cdecl;
SPrintf: function(dest: pchar; format: pchar; var1: cardinal): integer; cdecl;
//AZCheckPtr: function(p: pointer): integer; cdecl;
DSGetHandleSize: function(Handle: pointer): integer; cdecl;
DSNewPtr: function(size: integer): pointer; cdecl;
DSNewPClr: function(size: integer): pointer; cdecl;
DSDisposePtr: function(p: pointer): integer; cdecl;
DSCheckPtr: function(p: pointer): integer; cdecl;
DSNewHandle: function(size: integer): pointer; cdecl;
DSDisposeHandle: function(h: pointer): integer; cdecl;
DSRecoverHandle: function(p: pointer): pointer; cdecl;
RGetNamed: function(ResFileHandle: cardinal; ResType: integer;
                    ResName: PShortString; BinDataHandle: pointer): integer; cdecl;
RGet: function(ResFileHandle: cardinal; ResType: integer;
               Id: integer; BinDataHandle: pointer): integer; cdecl;
RGetInfo: function(BinDataHandle: pointer; Id, ResType: pcardinal;
                   ResName: PShortString): integer; cdecl;
ROpenFile: function(path: cardinal;
                    OpenMode: integer; //0-openReadWrite, 1-openReadOnly
                    PResFileHandle: pointer; PResType,
                    FileCreator: PCardinal): integer; cdecl;
RCloseFile: function(ResFileHandle: cardinal): integer; cdecl;
RRelease: function(BinDataHandle: pointer): integer; cdecl;
RDetach: function(BinDataHandle: pointer): integer; cdecl;
RAdd: function(BinDataHandle: pointer; ResFileHandle: cardinal; ResType,
               ResIndex: integer; ResName: PShortString): integer; cdecl;
RFReadWrite_Remove: function(ResType: integer; Id: integer): integer; stdcall;
RFReadWrite_LowLevelResFile: function: cardinal; stdcall;
LVResFile_RGet: function(ResType: integer; Id: integer;
                         class_Resource_ptr: pcardinal): integer; stdcall;
LVResFile_RRemove: function(class_Resource: cardinal): integer; stdcall;
LVResource_RGetInfo: function(Id, ResType: pcardinal;
                              ResName: PShortString): integer; stdcall;
FEmptyPath: function(path: cardinal): cardinal; cdecl;
FFlattenPath: function(path: cardinal; str_buffer: pointer): integer; cdecl;
FUnFlattenPath: function(str_buffer: pointer; path_ptr: pointer): integer; cdecl;
PathIsPseudoPath: function(path: cardinal; x: pointer): longbool; cdecl;
PseudoPathToPath: function(path: cardinal; x: pointer): integer; cdecl;
FDestroyPath: procedure(path_ptr: pointer); cdecl;
FTextToPath: function(Str: pointer; StrLength: integer;
                      path_ptr: pointer): integer; cdecl;
FNamePtr: function(path: cardinal; name: PShortString): integer; cdecl;
FAddPath: function(BasePath, RelPath, NewPath: cardinal): integer; cdecl;
FIsEmptyPath: function(path: cardinal): longbool; cdecl;
FDirName: function(Path, Dir: cardinal): integer; cdecl;
FPathCpy: function(DestPath, SrcPath: cardinal): integer; cdecl;
OneButtonAlert: function(StrType: integer; MsgText, ButtonText: PShortString;
                         X, Y: integer; Caption: PShortString): PCardinal; cdecl;
ExtFileDialog: function(Caption: PShortString; Init_Res_Path: Cardinal;
                        FileName: PShortString; CustomFilter: integer;
                        WindowType: integer; LVFilter: integer;
                        NotUsed: integer): integer; cdecl;
RevBL: procedure(NumberPtr: Pointer); cdecl;
gLVRTVersion: pchar;
GlobalSubNames, GlobalLVSBs, GlobalParents, GlobalSubPaths, GlobalOffsets: TStringList;
RTE: boolean;
DbgFilePath: string;
DbgFile: TextFile;
PatchAddress_First, PatchAddress_Second, PatchAddress_ForSave,
PatchAddress_ForPurge, PatchAddress_ForPurge2: cardinal;

Function WriteBytes(pAddress: Pointer; Bytes: Array of Byte): Boolean;
var
  OldProtect, DummyProtect: DWord;
begin
  if VirtualProtect(pAddress, SizeOf(Bytes), PAGE_EXECUTE_READWRITE, @OldProtect) then
   begin
    Move(Bytes, pAddress^, Length(Bytes));
    VirtualProtect(pAddress, SizeOf(Bytes), OldProtect, @DummyProtect);
    Result := True
   end
   else
    Result := False;
end;

Function WriteBytesWithBackup(pAddress: Pointer; Bytes: Array of Byte;
                              var Backup: Array of Byte): Boolean;
var
  OldProtect, DummyProtect: DWord;
begin
  if VirtualProtect(pAddress, SizeOf(Bytes), PAGE_EXECUTE_READWRITE, @OldProtect) then
   begin
    Move(pAddress^, Backup, Length(Backup));
    Move(Bytes, pAddress^, Length(Bytes));
    VirtualProtect(pAddress, SizeOf(Bytes), OldProtect, @DummyProtect);
    Result := True
   end
   else
    Result := False;
end;

function NumToChars(Value: Cardinal): String;
var
  C1, C2, C3, C4: Char;
begin
  C1 := PChar(@Value)^;
  C2 := PChar(Cardinal(@Value) + 1)^;
  C3 := PChar(Cardinal(@Value) + 2)^;
  C4 := PChar(Cardinal(@Value) + 3)^;
  if C1<>#0 then Result := C1;
  if C2<>#0 then Result := Result+C2;
  if C3<>#0 then Result := Result+C3;
  if C4<>#0 then Result := Result+C4;
end;

function CharsToNum(Value: String): Cardinal;
begin
case Length(Value) of
0: Result := 0;
1: Result := PByte(@Value[1])^;
2: Result := PWord(@Value[1])^;
else
Result := PCardinal(@Value[1])^;
end;
end;

function UnloadCIN(LVSBHead: cardinal): integer;
var CINModuleAddress: cardinal;
    ModuleName: pchar;
begin
UnloadCIN:=0;
if (LVSBHead<>0) then begin
Try
CINModuleAddress := PCardinal(LVSBHead + $1C)^;
Except on E:Exception do
CINModuleAddress := 0;
End;

if (CINModuleAddress<>0) then begin
GetMem(ModuleName, $104);
GetModuleFileName(CINModuleAddress, ModuleName, $104);

if FreeLibrary(CINModuleAddress) then
 DeleteFile(ModuleName)
else
 UnloadCIN:=GetLastError;

FreeMem(ModuleName);
end
else DSDisposePtr(Ptr(LVSBHead));
end;
end;

//CIN Lists procedures
procedure SortList(var List: TStringList);
var i, n: integer;
    b: boolean;
    p: string;
begin
n := List.Count;
if (n < 2) then exit;
repeat
  b := false;
  Dec(n);
  if (n > 0) then
  for i := 0 to n-1 do
   if StrToInt(List[i]) > StrToInt(List[i+1]) then begin
     p := List[i];
     List[i] := List[i+1];
     List[i+1] := p;
     b := true;
    end;
until not b;
end;

procedure ListCINTree(var TempList: TStringList; CIN_Name: string);
var i: integer;
begin
for i:=0 to GlobalParents.Count-1 do
 if (GlobalParents.Strings[i]=CIN_Name) then begin
  TempList.Add(GlobalSubNames[i]);
  ListCINTree(TempList, GlobalSubNames[i]);
 end;
//you'd remove duplicates from TempList on your own!
end;

procedure RemoveDuplicates(var List: TStringList);
var i: integer;
    TmpList: TStringList;
begin
TmpList := TStringList.Create;
TmpList.CaseSensitive := false;
for i:=0 to List.Count-1 do
 if TmpList.IndexOf(List[i])=-1 then TmpList.Add(List[i]);
List.Clear;
List.AddStrings(TmpList);
TmpList.Free;
end;

//define top level parent CINs by subroutine name
procedure DetermineMasterCIN(var Masters: TStringList; SubName: String);
var i, j: integer;
    SubNames, SubParents: TStringList;
begin
If (GlobalSubNames.IndexOf(SubName)>-1) or (GlobalParents.IndexOf(SubName)>-1) Then Begin
SubNames := TStringList.Create;
SubNames.CaseSensitive := false;
SubParents := TStringList.Create;
SubParents.CaseSensitive := false;
SubNames.Add(SubName);
Repeat
SubParents.Clear;
for i:=0 to SubNames.Count-1 do
 for j:=0 to GlobalSubNames.Count-1 do
  if GlobalSubNames[j]=SubNames[i] then
   SubParents.Add(GlobalParents[j]);

if (SubParents.Count>0) then begin

for i:=0 to SubNames.Count-1 do
 //keep master CIN names from erase
 if (GlobalSubNames.IndexOf(SubNames[i])=-1) then SubParents.Add(SubNames[i]);
SubNames.Clear;
SubNames.AddStrings(SubParents);
end;
Until (SubParents.Count = 0);

SubParents.Free;
RemoveDuplicates(SubNames);

Masters.AddStrings(SubNames);
SubNames.Free;
End;
end;

procedure DeleteESFromLists(SubNames: TStringList; MasterCIN: string);
var i,j: integer;
    indexes, Masters: TStringList;
begin
indexes := TStringList.Create;
indexes.CaseSensitive := false;
Masters := TStringList.Create;
Masters.CaseSensitive := false;
for i:=0 to SubNames.Count-1 do
 for j:=0 to GlobalSubNames.Count-1 do
  if (GlobalSubNames[j]=SubNames[i]) then begin
   Masters.Clear;
   DetermineMasterCIN(Masters,GlobalParents[j]);
   if (GlobalParents[j]=MasterCIN) or (Masters.IndexOf(MasterCIN)>-1) then begin
    { this condition can delete subs from list only by master name or
      by sub's parent name.
      it can not delete subs by its intermediate parent, e.g. we have
      sub <- parent :
      1 <- MC1
      2 <- 1
      3 <- 2
      so, DeleteESFromLists('3', 'MC1') will delete "3 <- 2" string (by master),
      DeleteESFromLists('3', '2') will delete "3 <- 2" string (by parent)
      and DeleteESFromLists('3', '1') does nothing! }
    indexes.Add(IntToStr(j));
   end;
  end;
Masters.Free;
RemoveDuplicates(indexes);
SortList(indexes);

//erase subroutine from all lists
for i:=indexes.Count-1 downto 0 do begin
GlobalLVSBs.Delete(StrToInt(indexes[i]));
GlobalSubNames.Delete(StrToInt(indexes[i]));
GlobalParents.Delete(StrToInt(indexes[i]));
GlobalSubPaths.Delete(StrToInt(indexes[i]));
GlobalOffsets.Delete(StrToInt(indexes[i]));
end;
indexes.Free;
end;

procedure FreeCINTree(CIN_Name: string);
var i,j: integer;
    TempList, Masters: TStringList;
begin
TempList := TStringList.Create;
TempList.CaseSensitive := false;
Masters := TStringList.Create;
Masters.CaseSensitive := false;
ListCINTree(TempList, CIN_Name); //get all child subroutines of current CIN
RemoveDuplicates(TempList);
for i:=0 to TempList.Count-1 do begin
 Masters.Clear;
 DetermineMasterCIN(Masters, TempList[i]);
 if (Masters.Count=1) then begin
  j:=GlobalSubNames.IndexOf(TempList[i]);
  if (j<>-1) then begin
   //DSDisposePtr(Ptr(StrToInt(GlobalLVSBs[j])));
   UnloadCIN(StrToInt(GlobalLVSBs[j]));
  end;
 end; //end to if (Masters.Count=1) then begin
 //DeleteESFromLists(TempList[i], CIN_Name);
end; //end to for

DeleteESFromLists(TempList, CIN_Name);
Masters.Free;
TempList.Free;
end;

//End of CIN Lists procedures

procedure LVMessage(Text: ShortString);
begin
OneButtonAlert($35, @Text, nil, $7FFF, $7FFF, nil);
end;

function LVDialog(Caption: ShortString; Init_Res_Path: Cardinal;
                  WindowType: integer; LVFilter: integer): integer;
begin
Result := ExtFileDialog(@Caption, Init_Res_Path, nil, 0,
                        WindowType, LVFilter, 0);
end;

procedure Dbg(fmt: string; str: string);
var DbgStr: ShortString;
begin
DbgStr:=str;
DbgPrintf_PStr(pchar(fmt), @DbgStr);
end;

procedure DumpToFile(const FileName: string; DataPtr: pointer; Length: integer);
var
  Stream: TFileStream;
begin
  Stream:= TFileStream.Create(FileName, fmCreate);
  try
    Stream.WriteBuffer(DataPtr^, Length);
  finally
    Stream.Free;
  end;
end;

function LVVersion: integer;
var tmp: string;
    version: integer;
begin
tmp:=Copy(gLVRTVersion, 1, 2);
if TryStrToInt(tmp, version) then
 LVVersion:=version
 else LVVersion:=0;
end;

function LoadCINFromRsrc(BinLVSBRsrc: PCardinal; RsrcName: string): cardinal;
var FileHandle, HandleSize, LibHandle: integer;
    TempPath, TempFileName: string;
    NumOfBytes, LVSBHeader: cardinal;
    GetLVSBHeader: function: Cardinal; cdecl;
    SetLVRTModule: procedure(Module: Cardinal); cdecl;
    Off1, Off2, Off3, Off4, Off5, CINLength, FullLength,
    Local1, Local2, TmpAddr: Cardinal;
    NewCINPtr: pointer;
    CINVer, OldProtect: Cardinal;
begin
Result := 0;
If (PWord(BinLVSBRsrc^)^=CharsToNum('MQ')) Then Begin
//CIN is in *.REX format (Phar Lap relocatable executable) (WATCOM compiler)
Off1 := PWord(BinLVSBRsrc^ + $6)^; //e.g., 1D
Off2 := PWord(BinLVSBRsrc^ + $A)^ shl $C; //e.g., 1 -> 1000
Off3 := PWord(BinLVSBRsrc^ + $8)^ shl $4; //REX header size (e.g., A -> A0)
Off4 := PWord(BinLVSBRsrc^ + $2)^; //e.g., C8
CINLength := PWord(BinLVSBRsrc^ + $4)^ shl $9; //C -> 1800
if (Off4<>0) then CINLength := Off4 + CINLength - $200; //C8 + 1800 - 200 = 16C8
FullLength := CINLength - Off3 + Off2; //16C8 - A0 + 1000 = 2628
NewCINPtr := DSNewPClr(FullLength);
if (Cardinal(NewCINPtr)=0) then Exit;
Move(PCardinal(BinLVSBRsrc^ + Off3)^, NewCINPtr^, FullLength - Off2);
Off5 := PWord(BinLVSBRsrc^ + $18)^; //e.g., 1E
Local1 := Off5 + BinLVSBRsrc^;
Local2 := Off1; //1D

if (Off1<>0) then
 while (Local2 > 0) do begin
  TmpAddr := (PCardinal(Local1)^ and $7FFFFFFF) + Cardinal(NewCINPtr);
  if (TmpAddr) >= (FullLength + Cardinal(NewCINPtr)) then begin
   DbgPrintf('While loop error');
   DSDisposePtr(NewCINPtr);
   Exit;
  end;
  if (PCardinal(Local1)^ and $80000000)=0 then //address in range [0..2147483647 (7FFFFFFF)]
   PWord(TmpAddr)^ := PWord(TmpAddr)^ + Word(NewCINPtr)
   else PCardinal(TmpAddr)^ := PCardinal(TmpAddr)^ + Cardinal(NewCINPtr);
  Inc(Local1, 4);
  Dec(Local2);
 end;

RevBL(Ptr(Cardinal(NewCINPtr) + $C)); //reverse bytes in an integer: e.g., 00|00|00|04 -> 04|00|00|00
CINVer := PCardinal(Cardinal(NewCINPtr) + $C)^;
DbgPrintf_Format('CIN version = %x',CINVer);
if (CINver<2) then begin
 LVMessage('The "'+RsrcName+'" CIN is compiled with an old version of the compiler. Please recompile.');
 DSDisposePtr(NewCINPtr);
 Exit;
end;
if (CINver>4) then begin
 LVMessage('The "'+RsrcName+'" CIN was built with a newer version of cintools and could not be loaded.');
 DSDisposePtr(NewCINPtr);
 Exit;
end;

local1 := PCardinal(BinLVSBRsrc^ + $14)^;
if (CINVer<4) then begin
 PCardinal(Cardinal(NewCINPtr) + $10)^ := local1 + Cardinal(NewCINPtr);
 if (local1=0) then begin
  if (PByte(NewCINPtr)^<>$E9) then begin
   DbgPrintf('E9 Error!');
   DSDisposePtr(NewCINPtr);
   Exit;
  end
  else
   PCardinal(Cardinal(NewCINPtr) + $10)^ := Cardinal(NewCINPtr) + PCardinal(Cardinal(NewCINPtr) + $1)^ + 5;
 end;
 PCardinal(NewCINPtr)^ := 0;
 PCardinal(Cardinal(NewCINPtr) + $4)^ := 0;
end;
PCardinal(Cardinal(NewCINPtr) + $18)^ := 0;
PCardinal(Cardinal(NewCINPtr) + $1C)^ := 0;
PCardinal(Cardinal(NewCINPtr) + $20)^ := 0;
PCardinal(Cardinal(NewCINPtr) + $24)^ := LVRTTable;
LVSBHeader := local1 + Cardinal(NewCINPtr);
PCardinal(Cardinal(NewCINPtr) + $28)^ := LVSBHeader;

if (not VirtualProtect(NewCINPtr, FullLength, PAGE_EXECUTE_READWRITE, @OldProtect)) then begin
 DSDisposePtr(NewCINPtr);
 Exit;
end;
//DumpToFile('C:\'+RsrcName+'.bin',NewCINPtr,FullLength - Off2);
//Showmessage(Format('LVSBHeader = 0x%x',[LVSBHeader]));
Result := LVSBHeader;
End
Else Begin //CIN is standard executable/DLL (MZ)
SetLength(TempPath, 260);
if GetTempPath(260, @TempPath[1])>0 then begin
 SetLength(TempFileName, MAX_PATH);
 if GetTempFileName(@TempPath[1], 'lvsb', 0, @TempFileName[1])>0 then begin
  FileHandle:=CreateFile(@TempFileName[1], GENERIC_READ or GENERIC_WRITE,
                         0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or
                         FILE_FLAG_WRITE_THROUGH, 0);
  if (FileHandle<>-1) then begin
   HandleSize := DSGetHandleSize(BinLVSBRsrc);
   if WriteFile(FileHandle, PCardinal(BinLVSBRsrc^)^, HandleSize, NumOfBytes, nil) then begin
    FlushFileBuffers(FileHandle);
    CloseHandle(FileHandle);
    SetErrorMode(0);
    LibHandle:=LoadLibrary(@TempFileName[1]);
    SetErrorMode(SEM_NOOPENFILEERRORBOX);
    if (LibHandle>0) then begin
     GetLVSBHeader := GetProcAddress(LibHandle, 'GetLVSBHeader');
     if Assigned(GetLVSBHeader) then begin
      LVSBHeader:=GetLVSBHeader;
      if (LVSBHeader>0) then
       if PCardinal(LVSBHeader+$C)^<=4 then begin
        SetLVRTModule := GetProcAddress(LibHandle, 'SetLVRTModule');
        if Assigned(SetLVRTModule) then SetLVRTModule(LVInstance);
        //GlobalSubNames.Add(RsrcName);
        //GlobalLVSBs.Add(IntToStr(LVSBHeader));
        PCardinal(LVSBHeader+$18)^:=0;
        PCardinal(LVSBHeader+$1C)^:=LibHandle;
        PCardinal(LVSBHeader+$20)^:=0;
        PCardinal(LVSBHeader+$24)^:=LVRTTable;
        PCardinal(LVSBHeader+$28)^:=LVSBHeader;
        Result := LVSBHeader;
       end //end to if PCardinal(LVSBHeader+$C)^<=4
       else begin
        FreeLibrary(LibHandle);
        DeleteFile(@TempFileName[1]);
        LVMessage('The "'+RsrcName+'" CIN was built with a newer version of cintools and could not be loaded.');
       end;
     end //end to if Assigned(GetLVSBHeader)
     else begin
      FreeLibrary(LibHandle);
      DeleteFile(@TempFileName[1]);
     end;
    end //if (LibHandle>0)
    else DeleteFile(@TempFileName[1]);
   end //end to if WriteFile
   else CloseHandle(FileHandle);
  end //end to if (FileHandle<>-1)
  else
   LVMessage('There was an error trying to create a temporary file. Please verify that your TEMP variable is ok.');
  end //end to if GetTempFileName
  else
   LVMessage('There was an error trying to create a temporary file. Please verify that your TEMP variable is ok.');
 end //end to if GetTempPath
 else
  LVMessage('There was an error trying to create a temporary file. Please verify that your TEMP variable is ok.');
End;
end;

function RecursiveCINLoad(LVSBHead, ResHandle, LSB_VI_Path: cardinal;
         ResNamePtr: PShortString): longbool;
var TmpPath, TmpPath2, extLVSBHead,
    TempResource, TempResType, TempResCreator, HandleSize: Cardinal;
    tmp1, tmp2, BinLVSBRsrc, BinLIsbRsrc: PCardinal;
    LSB_VI_PathStr, LIsb, TempStr, RawPart: string;
    TempPStr: ShortString;
    i, j, Return, index, NumBytes: integer;
    SubNames, SubPaths, SubOffsets{, LVSBs}: TStringList;
    Offset: array[0..3] of byte;
    Exists: boolean;
begin
Result := True;
////////////
//Return:=RGetNamed(Resource_class_handle, $6273494C, Res_Name_Ptr, tmp1);
Return:=RGetNamed(ResHandle, CharsToNum('LIsb'), ResNamePtr, @tmp1);
If RTE then Writeln(DbgFile,'RGetNamed returned '+IntToStr(Return)) else
 DbgPrintf_Format(pchar('RGetNamed returned %d'), Return);
if (Return <> 0) then begin
 if (Return<>15) then Result:=False; //no LIsb in resource
Exit;
end;
Return:=RDetach(tmp1);
If RTE then Writeln(DbgFile,'RDetach returned '+IntToStr(Return)) else
 DbgPrintf_Format(pchar('RDetach returned %d'), Return);
if (Return <> 0) then begin
Result:=False;
Exit;
end;
HandleSize:=DSGetHandleSize(tmp1);
If RTE then Writeln(DbgFile,Format('Handle size = 0x%x',[Return])) else
 DbgPrintf_Format(pchar('Handle size = 0x%x'), HandleSize);
tmp2 := PCardinal(tmp1^); //get pointer from handle
SetLength(LIsb, HandleSize);
Move(tmp2^, LIsb[1], Length(LIsb) * SizeOf(LIsb[1]));
If RTE then Writeln(DbgFile,'LIsb = '+LIsb) else
 Dbg('LIsb = %p', LIsb);

//If RTE then Writeln(DbgFile,Format('Handle size = 0x%x',[Return])) else
DbgPrintf_Format(pchar('LSB (vi) Path is %z'), LSB_VI_Path);
//convert Path to Delphi string
NumBytes := SPrintf(nil, '%z', LSB_VI_Path);
SetLength(TempStr, NumBytes);
SPrintf(@TempStr[1], '%z', LSB_VI_Path);
//end of convert
LSB_VI_PathStr:=ExtractFilePath(TempStr); //путь к файлу, заканчивающийся "\"

//parsing SubNames, SubPaths and SubOffsets

SubNames:=TStringList.Create;
SubNames.CaseSensitive := false;
SubPaths:=TStringList.Create;
SubPaths.CaseSensitive := false;
SubOffsets:=TStringList.Create;
SubOffsets.CaseSensitive := false;
//list of LVSBHeaders to clean up if error
//LVSBs:=TStringList.Create;
//LVSBs.CaseSensitive := false;

i:=Pos(#02'LVSB', LIsb);
While (i<>0) do begin
LIsb := Copy(LIsb, i+5, Length(LIsb));
j:=Pos(#02'LVSB', LIsb);
If (j<>0) then
 TempStr := Copy(LIsb, 1, j-1)
 else
 TempStr := Copy(LIsb, 1, Length(LIsb));
j:=Ord(TempStr[1]);
//If (Copy(TempStr,2,j)<>ResNamePtr^) then begin
If CompareText(Copy(TempStr,2,j),ResNamePtr^)<>0 then begin
SubNames.Add(Copy(TempStr,2,j));
RawPart:=Copy(TempStr, 1+j+1, Length(TempStr));
j:=pos('PTH', RawPart);
if (j<>0) then begin
 //SubPaths.Add(Copy(RawPart, j, Length(RawPart)));
 TmpPath := FEmptyPath(0);
 TempStr := Copy(RawPart, j, Length(RawPart));
 FUnFlattenPath(@TempStr[1], @TmpPath);
 If PathIsPseudoPath(TmpPath, nil) then PseudoPathToPath(TmpPath, nil);
 //resolve relative path (if any)
 TmpPath2 := FEmptyPath(0);
 FAddPath(LSB_VI_Path, TmpPath, TmpPath2);
 If not FIsEmptyPath(TmpPath2) then FPathCpy(TmpPath, TmpPath2);
 FDestroyPath(@TmpPath2);
 //convert Path to Delphi string
 NumBytes := SPrintf(nil, '%z', TmpPath);
 SetLength(TempStr, NumBytes);
 SPrintf(@TempStr[1], '%z', TmpPath);
 FDestroyPath(@TmpPath);
 //end of convert
 SubPaths.Add(TempStr);
 if ((j-6)>=0) then begin
  Offset[3]:=Ord(RawPart[j-6]);
  Offset[2]:=Ord(RawPart[j-5]);
  Offset[1]:=Ord(RawPart[j-4]);
  Offset[0]:=Ord(RawPart[j-3]);
  SubOffsets.Add(IntToStr(PCardinal(@Offset)^));
 end
 else SubOffsets.Add('');
 end
 else begin
 SubPaths.Add('');
 SubOffsets.Add('');
 end;
end;
i:=Pos(#02'LVSB', LIsb);
end;
//end of parsing

for i:=0 to SubNames.Count-1 do begin
If RTE then begin
Writeln(DbgFile,'Sub name '+inttostr(i)+' = '+SubNames[i]);
Writeln(DbgFile,'Sub path '+inttostr(i)+' = '+SubPaths[i]);
Writeln(DbgFile,'Sub offset '+inttostr(i)+' = '+SubOffsets[i]);
end
else begin
Dbg('Sub name '+inttostr(i)+' = %p', SubNames[i]);
Dbg('Sub path '+inttostr(i)+' = %p', SubPaths[i]);
Dbg('Sub offset '+inttostr(i)+' = %p', SubOffsets[i]);
end;
end;

//load ext. subroutines
TmpPath := FEmptyPath(0);
For i:=0 to SubNames.Count-1 do begin

//check if current LIsb resource is in global list
index := GlobalSubNames.IndexOf(SubNames[i]);
if (index>-1) then begin
If RTE then Writeln(DbgFile,'Ext. subroutine is in global list!') else
 DbgPrintf('Ext. subroutine is in global list!');
extLVSBHead := StrToInt(GlobalLVSBs[index]);
//write link to ext. sub
tmp1 := Ptr(LVSBHead + Cardinal(StrToInt(SubOffsets[i])));
tmp2 := Ptr(PCardinal(extLVSBHead + $10)^ + 0); //LVSBMain
if (PCardinal(extLVSBHead + $C)^ < $4) then
 tmp1^ := Cardinal(tmp2) else //WATCOM CIN
 tmp1^ := Cardinal(Ptr(tmp2^)); //standard CIN
//end of write

//if (GlobalParents[index]<>ResNamePtr^) then begin
if CompareText(GlobalParents[index],ResNamePtr^)<>0 then begin
//parents are different
//add new record to all string lists
GlobalSubNames.Add(GlobalSubNames[index]);
GlobalLVSBs.Add(GlobalLVSBs[index]);
GlobalParents.Add(ResNamePtr^);
GlobalSubPaths.Add(GlobalSubPaths[index]);
GlobalOffsets.Add(GlobalOffsets[index]);
end;
end
//end of check
else begin
Exists:=false;

If RTE then begin
  //going up one level
  //for example, from C:\Users\Ulyanov\Desktop\Application.exe\sum.lsb
  //to C:\Users\Ulyanov\Desktop\sum.lsb
  TempStr := ExtractFilePath(ExcludeTrailingPathDelimiter(LSB_VI_PathStr))+SubNames[i]+'.lsb';
  if FileExists(TempStr) then begin
   FTextToPath(@TempStr[1], Length(TempStr), @TmpPath);
   SubPaths[i] := TempStr; //
   Exists := true;
  end
End;

If not Exists then begin
 If FileExists(SubPaths[i]) then begin
  TempStr := SubPaths[i];
  FTextToPath(@TempStr[1], Length(TempStr), @TmpPath);
  Exists := true;
 End
end;

If not Exists then begin
 If FileExists(LSB_VI_PathStr+SubNames[i]+'.lsb') then begin
  TempStr := LSB_VI_PathStr+SubNames[i]+'.lsb';
  FTextToPath(@TempStr[1], Length(TempStr), @TmpPath);
  SubPaths[i] := TempStr; //
  Exists := true;
 End
end;

If not Exists then begin
//check in previous paths
  j:=0;
  while (j<=GlobalSubPaths.Count-1) and (not Exists) do begin
   TempStr := ExtractFilePath(GlobalSubPaths[j])+SubNames[i]+'.lsb';
   if FileExists(TempStr) then begin
    FTextToPath(@TempStr[1], Length(TempStr), @TmpPath);
    SubPaths[i] := TempStr; //
    Exists := true;
   end;
   Inc(j);
  end;
End;

If not Exists then begin //show dialog
  //set dialog path
  If not FIsEmptyPath(LSB_VI_Path) then FPathCpy(TmpPath, LSB_VI_Path);
  Return:=LVDialog('Please find the file of type LVSB named "'+
                   SubNames[i]+'.lsb"', TmpPath, $40149, $82);
  If (Return<>0) then begin
   FDestroyPath(@TmpPath);
   SubNames.Free;
   SubPaths.Free;
   SubOffsets.Free;
   //DSDisposePtr(Ptr(LVSBHead));
   //UnloadCIN(LVSBHead);
   {for j:=0 to LVSBs.Count-1 do begin
    DSDisposePtr(Ptr(StrToInt(LVSBs[j])));
    UnloadCIN(StrToInt(LVSBs[j]));
   end;}
   //LVSBs.Free;
   If RTE then Writeln(DbgFile,Format('Bad return from LVDialog: %d',[Return])) else
    DbgPrintf_Format('Bad return from LVDialog: %d',Return);
   Result:=False;
   Exit;
  end;
   //convert Path to Delphi string
   NumBytes := SPrintf(nil, '%z', TmpPath);
   SetLength(TempStr, NumBytes);
   SPrintf(@TempStr[1], '%z', TmpPath);
   //end of convert
   SubPaths[i] := TempStr;
   //if ExtractFileName(TempStr)<>SubNames[i]+'.lsb' then begin
   if CompareText(ExtractFileName(TempStr),SubNames[i]+'.lsb')<>0 then begin
    FDestroyPath(@TmpPath);
    SubNames.Free;
    SubPaths.Free;
    SubOffsets.Free;
    //DSDisposePtr(Ptr(LVSBHead));
    //UnloadCIN(LVSBHead);
    {for j:=0 to LVSBs.Count-1 do begin
     DSDisposePtr(Ptr(StrToInt(LVSBs[j])));
     UnloadCIN(StrToInt(LVSBs[j]));
    end;}
    //LVSBs.Free;
    If RTE then Writeln(DbgFile,'ExtractFileName not equals') else
     DbgPrintf('ExtractFileName not equals');
    Result:=False;
    Exit;
   end;
End; //end to LVDialog

DbgPrintf_Format(pchar('Path for '+SubNames[i]+' is %z'), TmpPath);
//load and analyse resource lsb
Return:=ROpenFile(TmpPath, 1, @TempResource, @TempResType, @TempResCreator);
If RTE then Writeln(DbgFile,Format('ROpenFile returned %d',[Return])) else
 DbgPrintf_Format(pchar('ROpenFile returned %d'), Return);
If RTE then Writeln(DbgFile,'TempResType^ = '+NumToChars(TempResType)) else
 DbgPrintf(pchar('TempResType^ = '+NumToChars(TempResType)));
//if (Return<>0) or (TempResType^<>$4253564C) then begin //string "LVSB"
if (Return<>0) or (TempResType<>CharsToNum('LVSB')) then begin
 if (TempResType<>CharsToNum('LVSB')) then RCloseFile(TempResource);
FDestroyPath(@TmpPath);
SubNames.Free;
SubPaths.Free;
SubOffsets.Free;
//DSDisposePtr(Ptr(LVSBHead));
//UnloadCIN(LVSBHead);
{for j:=0 to LVSBs.Count-1 do begin
 DSDisposePtr(Ptr(StrToInt(LVSBs[j])));
 UnloadCIN(StrToInt(LVSBs[j]));
end;}
//LVSBs.Free;
Result:=False;
Exit;
end;
If RTE then Writeln(DbgFile,Format('ResFile handle for '+SubNames[i]+' is 0x%x',[TempResource])) else
 DbgPrintf_Format(pchar('ResFile handle for '+SubNames[i]+' is 0x%x'), TempResource);
//
TempPStr := SubNames[i];
//Return:=RGetNamed(TempResPtr^, $54414C50, @TempPStr, tmp1); //"PLAT"
Return:=RGetNamed(TempResource, CharsToNum('PLAT'), @TempPStr, @tmp1);
If RTE then Writeln(DbgFile,Format('RGetNamed(PLAT) returned %d',[Return])) else
 DbgPrintf_Format(pchar('RGetNamed(PLAT) returned %d'), Return);
if (Return <> 0) then begin
RCloseFile(TempResource);
FDestroyPath(@TmpPath);
SubNames.Free;
SubPaths.Free;
SubOffsets.Free;
//DSDisposePtr(Ptr(LVSBHead));
//UnloadCIN(LVSBHead);
{for j:=0 to LVSBs.Count-1 do begin
 DSDisposePtr(Ptr(StrToInt(LVSBs[j])));
 UnloadCIN(StrToInt(LVSBs[j]));
end;}
//LVSBs.Free;
Result:=False;
Exit;
end;
tmp2 := PCardinal(tmp1^);
Return:=RRelease(tmp1);
If RTE then Writeln(DbgFile,Format('RRelease returned %d',[Return])) else
 DbgPrintf_Format(pchar('RRelease returned %d'), Return);
If RTE then Writeln(DbgFile,'PLAT = '+NumToChars(tmp2^)) else
 Dbg('PLAT = %p', NumToChars(tmp2^));
If (NumToChars(tmp2^)<>'i386') then begin
RCloseFile(TempResource);
FDestroyPath(@TmpPath);
SubNames.Free;
SubPaths.Free;
SubOffsets.Free;
//DSDisposePtr(Ptr(LVSBHead));
//UnloadCIN(LVSBHead);
{for j:=0 to LVSBs.Count-1 do begin
 DSDisposePtr(Ptr(StrToInt(LVSBs[j])));
 UnloadCIN(StrToInt(LVSBs[j]));
end;}
//LVSBs.Free;
Result:=False;
Exit;
end;

TempPStr := SubNames[i];
Return:=RGetNamed(TempResource, CharsToNum('LVSB'), @TempPStr, @BinLVSBRsrc);
If RTE then Writeln(DbgFile,Format('RRelease returned %d',[Return])) else
 DbgPrintf_Format(pchar('RRelease returned %d'), Return);
if (Return <> 0) then begin
LVMessage('Could not get resource named "'+TempPStr+'" from "'+
          ExtractFilePath(SubPaths[i])+'".');
RCloseFile(TempResource);
FDestroyPath(@TmpPath);
SubNames.Free;
SubPaths.Free;
SubOffsets.Free;
//DSDisposePtr(Ptr(LVSBHead));
//UnloadCIN(LVSBHead);
{for j:=0 to LVSBs.Count-1 do begin
 DSDisposePtr(Ptr(StrToInt(LVSBs[j])));
 UnloadCIN(StrToInt(LVSBs[j]));
end;}
//LVSBs.Free;
Result:=False;
Exit;
end;

New(tmp1);
New(tmp2);
SetLength(TempPStr, 256);
Return:=RGetInfo(BinLVSBRsrc, tmp1, tmp2, @TempPStr);
If RTE then Writeln(DbgFile,Format('RGetInfo returned %d',[Return])) else
 DbgPrintf_Format(pchar('RGetInfo returned %d'), Return);
If RTE then Writeln(DbgFile,Format('Index is %d',[tmp1^])) else
 DbgPrintf_Format(pchar('Index is %d'), tmp1^);
If RTE then Writeln(DbgFile,'Type is '+NumToChars(tmp2^)) else
 Dbg('Type is %p', NumToChars(tmp2^));
If RTE then Writeln(DbgFile,'Name is '+TempPStr) else
 Dbg('Name is %p', TempPStr);
Dispose(tmp2);
Dispose(tmp1);

Return:=RDetach(BinLVSBRsrc);
If RTE then Writeln(DbgFile,Format('RDetach returned %d',[Return])) else
 DbgPrintf_Format(pchar('RDetach returned %d'), Return);
if (Return <> 0) then begin
RCloseFile(TempResource);
FDestroyPath(@TmpPath);
SubNames.Free;
SubPaths.Free;
SubOffsets.Free;
//DSDisposePtr(Ptr(LVSBHead));
//UnloadCIN(LVSBHead);
{for j:=0 to LVSBs.Count-1 do begin
 DSDisposePtr(Ptr(StrToInt(LVSBs[j])));
 UnloadCIN(StrToInt(LVSBs[j]));
end;}
//LVSBs.Free;
Result:=False;
Exit;
end;

extLVSBHead:=LoadCINFromRsrc(BinLVSBRsrc, SubNames[i]);
If RTE then Writeln(DbgFile,Format('New LVSB header is 0x%x',[extLVSBHead])) else
 DbgPrintf_Format(pchar('New LVSB header is 0x%x'),extLVSBHead);
if (extLVSBHead=0) then begin
If RTE then Writeln(DbgFile,'External sub LVSBHeader is null') else
 DbgPrintf('External sub LVSBHeader is null');
RCloseFile(TempResource);
FDestroyPath(@TmpPath);
SubNames.Free;
SubPaths.Free;
SubOffsets.Free;
//DSDisposePtr(Ptr(LVSBHead));
//UnloadCIN(LVSBHead);
{for j:=0 to LVSBs.Count-1 do begin
 DSDisposePtr(Ptr(StrToInt(LVSBs[j])));
 UnloadCIN(StrToInt(LVSBs[j]));
end;}
//LVSBs.Free;
Result:=False;
Exit;
end;

if (StrToInt(SubOffsets[i])<$38) then begin
If RTE then Writeln(DbgFile,'Patching LVSB with LVSB at bad offset') else
 DbgPrintf('Patching LVSB with LVSB at bad offset');
RCloseFile(TempResource);
FDestroyPath(@TmpPath);
SubNames.Free;
SubPaths.Free;
SubOffsets.Free;
//DSDisposePtr(Ptr(extLVSBHead));
UnloadCIN(extLVSBHead);
{for j:=0 to LVSBs.Count-1 do begin
 DSDisposePtr(Ptr(StrToInt(LVSBs[j])));
 UnloadCIN(StrToInt(LVSBs[j]));
end;}
//LVSBs.Free;
Result:=False;
Exit;
end;

GlobalSubNames.Add(SubNames[i]);
GlobalLVSBs.Add(IntToStr(extLVSBHead));
GlobalParents.Add(ResNamePtr^);
GlobalSubPaths.Add(SubPaths[i]);
GlobalOffsets.Add(SubOffsets[i]);

//write link to ext. sub
tmp1 := Ptr(LVSBHead + Cardinal(StrToInt(SubOffsets[i])));
tmp2 := Ptr(PCardinal(extLVSBHead + $10)^ + 0); //LVSBMain
if (PCardinal(extLVSBHead + $C)^ < $4) then
 tmp1^ := Cardinal(tmp2) else //WATCOM CIN
 tmp1^ := Cardinal(Ptr(tmp2^)); //standard CIN
//end of write

TempPStr := SubNames[i];
RGetNamed(TempResource, CharsToNum('LIsb'), @TempPStr, @BinLIsbRsrc);
if Assigned(BinLIsbRsrc) then begin
  If not RecursiveCINLoad(extLVSBHead,TempResource,LSB_VI_Path,@TempPStr)
  then begin
   RCloseFile(TempResource);
   FDestroyPath(@TmpPath);
   SubNames.Free;
   SubPaths.Free;
   SubOffsets.Free;
   //DSDisposePtr(Ptr(extLVSBHead));  !
   //UnloadCIN(extLVSBHead);
   {for j:=0 to LVSBs.Count-1 do begin
    DSDisposePtr(Ptr(StrToInt(LVSBs[j])));
    UnloadCIN(StrToInt(LVSBs[j]));
   end;}
   //LVSBs.Free;
   Result:=False;
   Exit;
  end;
end;
RCloseFile(TempResource);
//LVSBs.Add(IntToStr(extLVSBHead));
//end of load and analyse
end;
End; //end to For
FDestroyPath(@TmpPath); //MUST BE HERE~!
//RCloseFile(TempResource);
//FDestroyPath(@TmpPath);
//end of load
SubNames.Free;
SubPaths.Free;
SubOffsets.Free;
//LVSBs.Free;
///////////
end;

function ProcessExternal(LVSBHead, void, Resource_class_handle,
         LinkIdentity_class_ptr: cardinal; FuncResult: PCardinal;
         Res_Name_Ptr: PShortString; RFReader: cardinal): integer; cdecl;
var CINModuleAddress, LSB_VI_Path,
    TempResource, TempResType, TempResCreator: Cardinal;
    tmp1, tmp2: PCardinal;
    ModuleName: pchar;
    ReloadCounter,i,j: integer;
begin
ProcessExternal:=0;
If RTE then begin
Writeln(DbgFile,'-----LOAD CIN BEGIN-----');
//Writeln(DbgFile,'Resource name is "'+Res_Name_Ptr+'"');
Writeln(DbgFile,Format('Resource name is "%s"',[Res_Name_Ptr^]));
Writeln(DbgFile,Format('void is 0x%x',[void]));
Writeln(DbgFile,Format('LVSB ResFile handle is 0x%x',[Resource_class_handle]));
Writeln(DbgFile,Format('LinkIdentity_class_ptr is 0x%x',[LinkIdentity_class_ptr]));
Writeln(DbgFile,Format('RFReader is 0x%x',[RFReader]));
end
else begin
DbgPrintf('-----LOAD CIN BEGIN-----');
DbgPrintf_PStr(pchar('Resource name is "%p"'), Res_Name_Ptr);
DbgPrintf_Format(pchar('void is 0x%x'),void);
DbgPrintf_Format(pchar('LVSB ResFile handle is 0x%x'),Resource_class_handle);
DbgPrintf_Format(pchar('LinkIdentity_class_ptr is 0x%x'),LinkIdentity_class_ptr);
DbgPrintf_Format(pchar('RFReader is 0x%x'),RFReader);
end;

Try
tmp1 := Ptr(LVSBHead + $1C);
CINModuleAddress := tmp1^;
tmp1 := Ptr(LVSBHead + $14);
ReloadCounter := tmp1^;
Except on E:Exception do begin
CINModuleAddress := 0;
ReloadCounter := 0;
end;
End;

If RTE then begin
Writeln(DbgFile,Format('cin hdr = 0x%x',[LVSBHead]));
Writeln(DbgFile,Format('cin module addr = 0x%x',[CINModuleAddress]));
Writeln(DbgFile,Format('rld counter = %d',[ReloadCounter]));
end
else begin
DbgPrintf_Format(pchar('cin hdr = 0x%x'), LVSBHead);
DbgPrintf_Format(pchar('cin module addr = 0x%x'), CINModuleAddress);
DbgPrintf_Format(pchar('rld counter = %d'), ReloadCounter);
end;

GetMem(ModuleName, $104);
GetModuleFileName(CINModuleAddress, ModuleName, $104);
If RTE then Writeln(DbgFile,'CIN name = '+ModuleName) else
 Dbg('CIN name = %p', ModuleName);
FreeMem(ModuleName);

//If (PCardinal(LVSBHead+$8)^<>$204E4943) then begin //string "CIN "
 //If (PCardinal(LVSBHead+$1C)^=$454B4146) then //string "FAKE"
If (PCardinal(LVSBHead+$8)^<>CharsToNum('CIN ')) then begin
 If (PCardinal(LVSBHead+$1C)^=CharsToNum('FAKE')) then
  DSDisposePtr(Ptr(LVSBHead))
 else UnloadCIN(LVSBHead);
FuncResult^ := $0F;
//OneButtonAlert($35,'Cannot load a Subroutine as a CIN.',0,$7FFF,$7FFF,0);
LVMessage('Cannot load a Subroutine as a CIN.');
If RTE then Writeln(DbgFile,'-----LOAD CIN END-----') else
 DbgPrintf('-----LOAD CIN END-----');
ProcessExternal:=1;
Exit;
end;

//determine path to current *.lsb or current VI
LSB_VI_Path:=0;
Try
//LinkIdentity::GetPath function
tmp1 := Ptr(LinkIdentity_class_ptr);
if (tmp1^<>0) then begin
 if (LVVersion<14) then tmp2 := Ptr(tmp1^ + $240)
 else tmp2 := Ptr(tmp1^ + $40);
 LSB_VI_Path := tmp2^;
end;
Except on E:Exception do
LSB_VI_Path := 0;
End;

if (LSB_VI_Path=0) then begin
Try
tmp1 := Ptr(void + $51);
//LI_vi := tmp1^ + $2C;
//LinkIdentity::GetPath function
if (tmp1^<>0) then begin
 tmp1 := Ptr(tmp1^ + $2C);
 //DbgPrintf_Format(pchar('LI_vi is 0x%x'), cardinal(tmp1));
 if (tmp1^<>0) then begin
  if (LVVersion<14) then tmp2 := Ptr(tmp1^ + $240)
  else tmp2 := Ptr(tmp1^ + $40);
  LSB_VI_Path := tmp2^;
 end;
end;
Except on E:Exception do
LSB_VI_Path := 0;
End;
end;

if (LSB_VI_Path=0) then begin
Try
tmp1 := Ptr(LinkIdentity_class_ptr + $B);
if (tmp1^<>0) then begin
 tmp2 := Ptr(tmp1^ + $29);
 if (tmp2^<>0) then begin
  if (LVVersion<14) then tmp1 := Ptr(tmp2^ + $240)
  else tmp1 := Ptr(tmp2^ + $40);
  LSB_VI_Path := tmp1^;
 end;
end;
Except on E:Exception do
LSB_VI_Path := 0;
End;
end;

//for RTE 2010
if (LSB_VI_Path=0) then begin
Try
tmp1 := Ptr(LinkIdentity_class_ptr + $8);
if (tmp1^<>0) then begin
 tmp2 := Ptr(tmp1^ + $B8); //~!
 if (tmp2^<>0) then begin
  //tmp1 := Ptr(tmp2^ + $240);
  //LSB_VI_Path := tmp1^;
  tmp1 := Ptr(tmp2^);
  if (tmp1^<>0) then begin
   tmp2 := Ptr(tmp1^ + $8);
   if (tmp2^<>0) then begin
    tmp1 := Ptr(tmp2^ + $24); //24 instead of 2C
    if (tmp1^<>0) then begin
     tmp2 := Ptr(tmp1^ + $240);
     LSB_VI_Path := tmp2^;
    end;
   end;
  end;
 end;
end;
Except on E:Exception do
LSB_VI_Path := 0;
End;
end;

//for RTE 2011 & 2012
if (LSB_VI_Path=0) then begin
Try
tmp1 := Ptr(LinkIdentity_class_ptr + $8);
if (tmp1^<>0) then begin
 tmp2 := Ptr(tmp1^ + $B8); //~!
 if (tmp2^<>0) then begin
  //tmp1 := Ptr(tmp2^ + $240);
  //LSB_VI_Path := tmp1^;
  tmp1 := Ptr(tmp2^);
  if (tmp1^<>0) then begin
   tmp2 := Ptr(tmp1^ + $8);
   if (tmp2^<>0) then begin
    tmp1 := Ptr(tmp2^ + $2C); //~!
    if (tmp1^<>0) then begin
     tmp2 := Ptr(tmp1^ + $240);
     LSB_VI_Path := tmp2^;
    end;
   end;
  end;
 end;
end;
Except on E:Exception do
LSB_VI_Path := 0;
End;
end;

//for RTE 2013
if (LSB_VI_Path=0) then begin
Try
tmp1 := Ptr(LinkIdentity_class_ptr + $8);
if (tmp1^<>0) then begin
 tmp2 := Ptr(tmp1^ + $BC); //BC instead of B8
 if (tmp2^<>0) then begin
  //tmp1 := Ptr(tmp2^ + $240);
  //LSB_VI_Path := tmp1^;
  tmp1 := Ptr(tmp2^);
  if (tmp1^<>0) then begin
   tmp2 := Ptr(tmp1^ + $8);
   if (tmp2^<>0) then begin
    tmp1 := Ptr(tmp2^ + $2C); //~!
    if (tmp1^<>0) then begin
     tmp2 := Ptr(tmp1^ + $240);
     LSB_VI_Path := tmp2^;
    end;
   end;
  end;
 end;
end;
Except on E:Exception do
LSB_VI_Path := 0;
End;
end;

//for RTE 2014
if (LSB_VI_Path=0) then begin
Try
tmp1 := Ptr(LinkIdentity_class_ptr + $8);
if (tmp1^<>0) then begin
 tmp2 := Ptr(tmp1^ + $4C); //~!
 if (tmp2^<>0) then begin
  //tmp1 := Ptr(tmp2^ + $240);
  //LSB_VI_Path := tmp1^;
  tmp1 := Ptr(tmp2^);
  if (tmp1^<>0) then begin
   tmp2 := Ptr(tmp1^ + $8);
   if (tmp2^<>0) then begin
    tmp1 := Ptr(tmp2^ + $4); //~!
    if (tmp1^<>0) then begin
     tmp2 := Ptr(tmp1^ + $40); //~!!
     LSB_VI_Path := tmp2^;
    end;
   end;
  end;
 end;
end;
Except on E:Exception do
LSB_VI_Path := 0;
End;
end;
//end of determine

if (LSB_VI_Path=0) then begin
  LVMessage('LSB/VI Path is empty!');
  If RTE then Writeln(DbgFile,'-----LOAD CIN END-----') else
   DbgPrintf('-----LOAD CIN END-----');
  FuncResult^ := $0F;
  ProcessExternal:=1;
  Exit;
end
else DbgPrintf_Format(pchar('Resolved path is "%z"'), LSB_VI_Path);

TempResource := 0;
if (Resource_class_handle=0) then begin
{
Try
//class ResChain & __thiscall RFReader::LowLevelResChain(void)
tmp1 := Ptr(RFReader + $5);
if (tmp1^<>0) then begin
tmp2 := Ptr(tmp1^);
Resource_class_handle := tmp2^;
end;
Except on E:Exception do
Resource_class_handle := 0;
End;}
//
{
asm
mov ECX, RFReader
end;
Resource_class_handle := RFReader_MapToObsoleteRsrcFile;
}
ROpenFile(LSB_VI_Path, 1, @TempResource, @TempResType, @TempResCreator);
Resource_class_handle := TempResource;
end;

if (Resource_class_handle=0) then begin
  If RTE then Writeln(DbgFile,'Resource class handle is empty!') else
   DbgPrintf('Resource class handle is empty!');
  If RTE then Writeln(DbgFile,'-----LOAD CIN END-----') else
   DbgPrintf('-----LOAD CIN END-----');
  FuncResult^ := $0F;
  ProcessExternal:=1;
  Exit;
end
else
If RTE then Writeln(DbgFile,Format('Resource class handle is 0x%x',[Resource_class_handle])) else
 DbgPrintf_Format(pchar('Resource class handle is 0x%x'), Resource_class_handle);


If not RecursiveCINLoad(LVSBHead,Resource_class_handle,LSB_VI_Path,Res_Name_Ptr)
 then begin
  //DSDisposePtr(Ptr(LVSBHead));
  UnloadCIN(LVSBHead);
  FreeCINTree(Res_Name_Ptr^);
  LVMessage('Error loading external subroutine.');
  FuncResult^ := $0F;
  ProcessExternal:=1;
 end;
//$18 - Ext subs not supported
//$0F - Bad platform
if (TempResource<>0) then RCloseFile(TempResource);
If RTE then Writeln(DbgFile,'-----LOAD CIN END-----') else
 DbgPrintf('-----LOAD CIN END-----');
If RTE then Flush(DbgFile);
end;

function SaveCIN(LVSBdata: pointer; DataSize, Res_Index: integer;
                 LVSB_Name: PShortString;
                 LinkIdentity_class_ptr: cardinal): integer; cdecl;
var tmp1, tmp2: PCardinal;
    Resource_class_handle, TmpPath: cardinal;
    TempStr: string;
    i,j,k, Return, NumBytes, NumOfSubs, TempOffset: integer;
    LIsbBinData, FlatPath: array of byte;
    Offset: array[0..3] of byte;
begin
SaveCIN:=0;
If RTE then begin
Writeln(DbgFile,'-----SAVE CIN BEGIN-----');
Writeln(DbgFile,Format('LVSBdata ptr is 0x%x',[cardinal(LVSBdata)]));
Writeln(DbgFile,Format('Data size is 0x%x',[DataSize]));
Writeln(DbgFile,Format('Res_Index is 0x%x',[Res_Index]));
Writeln(DbgFile,Format('LVSB name is "%s"',[LVSB_Name]));
Writeln(DbgFile,Format('LI ptr is 0x%x',[LinkIdentity_class_ptr]));
end
else begin
DbgPrintf('-----SAVE CIN BEGIN-----');
DbgPrintf_Format(pchar('LVSBdata ptr is 0x%x'),cardinal(LVSBdata));
DbgPrintf_Format(pchar('Data size is 0x%x'),DataSize);
DbgPrintf_Format(pchar('Res_Index is 0x%x'),Res_Index);
DbgPrintf_PStr(pchar('LVSB name is "%p"'), LVSB_Name);
DbgPrintf_Format(pchar('LI ptr is 0x%x'),LinkIdentity_class_ptr);
end;

//get Resource class from LinkIdentity class ptr
Try
Resource_class_handle := PCardinal(LinkIdentity_class_ptr + $8)^;
Except on E:Exception do
Resource_class_handle := 0;
End;

if (Resource_class_handle=0) then begin
Try
Resource_class_handle := PCardinal(LinkIdentity_class_ptr + $C)^;
Except on E:Exception do
Resource_class_handle := 0;
End;
end;
//end of get Resource class
If RTE then Writeln(DbgFile,Format('Resource_class_handle is 0x%x',[Resource_class_handle])) else
 DbgPrintf_Format(pchar('Resource_class_handle is 0x%x'),Resource_class_handle);

//write PLAT
TempStr := 'i386';
//tmp1 := @TempStr[1];
//tmp2 := @tmp1;
tmp1 := DSNewHandle(4);
tmp2 := Ptr(tmp1^);
Move(TempStr[1], tmp2^, Length(TempStr) * SizeOf(TempStr[1]));
Return:=RAdd(tmp1, Resource_class_handle, CharsToNum('PLAT'), Res_Index, LVSB_Name);
//DSDisposeHandle(tmp2);
if (Return<>0) then begin
If RTE then Writeln(DbgFile,'-----SAVE CIN END-----') else
 DbgPrintf('-----SAVE CIN END-----');
Finalize(LIsbBinData);
Finalize(FlatPath);
Exit;
end;
//end of write PLAT

//write LVSB
tmp1 := DSNewHandle(DataSize);
tmp2 := Ptr(tmp1^);
Move(LVSBdata^, tmp2^, DataSize);
Return:=RAdd(tmp1, Resource_class_handle, CharsToNum('LVSB'), Res_Index, LVSB_Name);
//DSDisposeHandle(tmp2);
if (Return<>0) then begin
If RTE then Writeln(DbgFile,'-----SAVE CIN END-----') else
 DbgPrintf('-----SAVE CIN END-----');
Finalize(LIsbBinData);
Finalize(FlatPath);
Exit;
end;
//end of write LVSB

//write LIsb
j := Length(LVSB_Name^);
SetLength(LIsbBinData, 7+j+7);
LIsbBinData[0]:=$00; //test -- must be $00
LIsbBinData[1]:=$01;
LIsbBinData[2]:=$4C; //"L"
LIsbBinData[3]:=$56; //"V"
LIsbBinData[4]:=$53; //"S"
LIsbBinData[5]:=$42; //"B"
Move(LVSB_Name^,LIsbBinData[6],j+1);
LIsbBinData[7+j+0]:=$00;
LIsbBinData[7+j+1]:=$00;
LIsbBinData[7+j+2]:=$00;
LIsbBinData[7+j+3]:=$00;
LIsbBinData[7+j+4]:=$00;
LIsbBinData[7+j+5]:=$00;
LIsbBinData[7+j+6]:=$01; //num of subs
{
LIsbBinData[7+j+7]:=$00;
LIsbBinData[7+j+8]:=$02;
LIsbBinData[7+j+9]:=$4C; //"L"
LIsbBinData[7+j+10]:=$56; //"V"
LIsbBinData[7+j+11]:=$53; //"S"
LIsbBinData[7+j+12]:=$42; //"B"
}
TmpPath := FEmptyPath(0);
NumOfSubs := 0;
For i:=0 to GlobalParents.Count-1 do Begin
 If (CompareText(GlobalParents.Strings[i],LVSB_Name^)=0) then begin
 //sub name -> GlobalSubNames
 //sub offset -> GlobalOffsets
 //sub path -> GlobalSubPaths
 //convert Delphi path to LV flattened path
 TempStr := GlobalSubPaths.Strings[i];
 FTextToPath(@TempStr[1], Length(TempStr), @TmpPath);
 NumBytes := FFlattenPath(TmpPath, nil);
 //SetLength(TempStr, NumBytes);
 SetLength(FlatPath, NumBytes);
 //FFlattenPath(TmpPath, @TempStr[1]);
 FFlattenPath(TmpPath, @FlatPath[0]);
 //FlatPath := TempStr;
 //end of convert
 //convert sub offset to hex form
 if not TryStrToInt(GlobalOffsets.Strings[i], TempOffset) then
  TempOffset := $38;
  Offset[0] := Hi(TempOffset shr 16);
  Offset[1] := Lo(TempOffset shr 16);
  Offset[2] := Lo(TempOffset shr 8);
  Offset[3] := Lo(TempOffset);
 //end of convert
  //j := 6+1+Length(GlobalSubNames.Strings[i])+4+Length(Offset)+2+Length(FlatPath);
  //SetLength(LIsbBinData, Length(LIsbBinData)+j);
  j := Length(LIsbBinData);
  SetLength(LIsbBinData, j+6+1+Length(GlobalSubNames.Strings[i])+4+Length(Offset)+2+Length(FlatPath));
  LIsbBinData[j+0]:=$00;
  LIsbBinData[j+1]:=$02;
  LIsbBinData[j+2]:=$4C; //"L"
  LIsbBinData[j+3]:=$56; //"V"
  LIsbBinData[j+4]:=$53; //"S"
  LIsbBinData[j+5]:=$42; //"B"
  k := Length(GlobalSubNames.Strings[i]);
  LIsbBinData[j+6]:=k;
  Move(GlobalSubNames.Strings[i][1],LIsbBinData[j+7],k);
  LIsbBinData[j+7+k]:=$00;
  LIsbBinData[j+7+k+1]:=$00;
  LIsbBinData[j+7+k+2]:=$00;
  LIsbBinData[j+7+k+3]:=$01;
  //Length(Offset) is always =4, so it's const
  Move(Offset[0],LIsbBinData[j+7+k+4],4);
  LIsbBinData[j+7+k+8]:=$00;
  LIsbBinData[j+7+k+9]:=$00;
  Move(FlatPath[0],LIsbBinData[j+7+k+10],Length(FlatPath));
  Inc(NumOfSubs);
  LIsbBinData[7+Length(LVSB_Name^)+6]:=NumOfSubs; //num of subs
 end;
End;
FDestroyPath(@TmpPath);

if (NumOfSubs>0) then begin
//write LIsb
tmp1 := DSNewHandle(Length(LIsbBinData));
tmp2 := Ptr(tmp1^);
Move(LIsbBinData[0], tmp2^, Length(LIsbBinData));
Return:=RAdd(tmp1, Resource_class_handle, CharsToNum('LIsb'), Res_Index, LVSB_Name);
If RTE then Writeln(DbgFile,Format('RAdd LIsb returned %d',[Return])) else
 DbgPrintf_Format(pchar('RAdd LIsb returned %d'),Return);
//end of write LIsb
end;
   DumpToFile('C:\LV4.bin',@LIsbBinData[0],Length(LIsbBinData));

//end of write LIsb
If RTE then Writeln(DbgFile,'-----SAVE CIN END-----') else
 DbgPrintf('-----SAVE CIN END-----');
Finalize(LIsbBinData);
Finalize(FlatPath);
If RTE then Flush(DbgFile);
end;

procedure PurgeCIN(RFReadWrite, LVSBHead: cardinal); cdecl;
var tmp1, tmp2: PCardinal;
    Return, Id: integer;
    ResType, LVResFile, LVResource: cardinal;
    CIN_Name: ShortString;
begin
//
If RTE then begin
Writeln(DbgFile,'-----PURGE CIN BEGIN-----');
Writeln(DbgFile,Format('RFReadWrite class is 0x%x',[RFReadWrite]));
Writeln(DbgFile,Format('LVSBHead is 0x%x',[LVSBHead]));
end
else begin
DbgPrintf('-----PURGE CIN BEGIN-----');
DbgPrintf_Format(pchar('RFReadWrite class is 0x%x'),RFReadWrite);
DbgPrintf_Format(pchar('LVSBHead is 0x%x'),LVSBHead);
end;

If (PCardinal(LVSBHead+$8)^=CharsToNum('CIN ')) then begin

Id := PCardinal(LVSBHead+$14)^;
If RTE then Writeln(DbgFile,Format('Id = %d',[Id])) else
 DbgPrintf_Format(pchar('Id = %d'), Id);

if (RTE) or (mgcore=0) then begin     //1
LVResFile := 0;
Try
//RFReadWrite::LowLevelResFile function
tmp1 := Ptr(RFReadWrite + $5);
if (tmp1^<>0) then begin
 LVResFile := tmp1^;
end;
Except on E:Exception do
LVResFile := 0;
End;
end
else begin
asm
mov ecx, RFReadWrite
end;
LVResFile := RFReadWrite_LowLevelResFile;
end;
If RTE then Writeln(DbgFile,Format('Low level res file: 0x%x',[LVResFile])) else
 DbgPrintf_Format(pchar('Low level res file: 0x%x'), LVResFile);

ResType := CharsToNum('LVSB');

if (RTE) or (mgcore=0) then begin //define LVResFile::RGet     2
@LVResFile_RGet := nil;
Try
tmp1 := Ptr(LVResFile);
if (tmp1^<>0) then begin
 tmp2 := Ptr(tmp1^ + $8);
 if (tmp2^<>0) then begin
  @LVResFile_RGet := Ptr(tmp2^);
 end;
end;
Except on E:Exception do
@LVResFile_RGet := nil;
End;
end;

if Assigned(LVResFile_RGet) then begin
asm
mov ecx, LVResFile
end;
LVResFile_RGet(ResType, Id, @LVResource);
end;

if (RTE) or (mgcore=0) then begin //define LVResource::RGetInfo     3
@LVResource_RGetInfo := nil;
Try
tmp1 := Ptr(LVResource);
if (tmp1^<>0) then begin
 tmp2 := Ptr(tmp1^ + $18);
 if (tmp2^<>0) then begin
  @LVResource_RGetInfo := Ptr(tmp2^);
 end;
end;
Except on E:Exception do
@LVResource_RGetInfo := nil;
End;
end;

if Assigned(LVResource_RGetInfo) then begin
New(tmp1);
New(tmp2);
asm
mov ecx, LVResource
end;
Return:=LVResource_RGetInfo(tmp1, tmp2, @CIN_Name);
If RTE then Writeln(DbgFile,Format('LVResource_RGetInfo returned %d',[Return])) else
 DbgPrintf_Format(pchar('LVResource_RGetInfo returned %d'), Return);
If RTE then Writeln(DbgFile,Format('Index is %d',[tmp1^])) else
 DbgPrintf_Format(pchar('Index is %d'), tmp1^);
If RTE then Writeln(DbgFile,'Type is '+NumToChars(tmp2^)) else
 Dbg('Type is %p', NumToChars(tmp2^));
If RTE then Writeln(DbgFile,'Name is '+CIN_Name) else
 Dbg('Name is %p', CIN_Name);
Dispose(tmp2);
Dispose(tmp1);
end;

FreeCINTree(CIN_Name);

//remove LVSB, PLAT & LIsb resources from main VI resource
if (RTE) or (mgcore=0) then begin                    //4
//define LVResFile::RRemove
@LVResFile_RRemove := nil;
Try
tmp1 := Ptr(LVResFile);
if (tmp1^<>0) then begin
 tmp2 := Ptr(tmp1^ + $34);
 if (tmp2^<>0) then begin
  @LVResFile_RRemove := Ptr(tmp2^);
 end;
end;
Except on E:Exception do
@LVResFile_RRemove := nil;
End;

ResType := CharsToNum('LVSB');

if Assigned(LVResFile_RGet) then begin
asm
mov ecx, LVResFile
end;
LVResFile_RGet(ResType, Id, @LVResource);
end;

if Assigned(LVResFile_RRemove) then begin
asm
mov ecx, LVResFile
end;
LVResFile_RRemove(LVResource);
end;

ResType := CharsToNum('PLAT');

if Assigned(LVResFile_RGet) then begin
asm
mov ecx, LVResFile
end;
LVResFile_RGet(ResType, Id, @LVResource);
end;

if Assigned(LVResFile_RRemove) then begin
asm
mov ecx, LVResFile
end;
LVResFile_RRemove(LVResource);
end;

ResType := CharsToNum('LIsb');

if Assigned(LVResFile_RGet) then begin
asm
mov ecx, LVResFile
end;
LVResFile_RGet(ResType, Id, @LVResource);
end;

if Assigned(LVResFile_RRemove) then begin
asm
mov ecx, LVResFile
end;
LVResFile_RRemove(LVResource);
end;

end
else begin
ResType := CharsToNum('LVSB');

asm
mov ecx, RFReadWrite
end;
RFReadWrite_Remove(ResType, Id);

ResType := CharsToNum('PLAT');

asm
mov ecx, RFReadWrite
end;
RFReadWrite_Remove(ResType, Id);

ResType := CharsToNum('LIsb');

asm
mov ecx, RFReadWrite
end;
RFReadWrite_Remove(ResType, Id);
end;
end; //end to If (PCardinal(LVSBHead+$8)^=CharsToNum('CIN '))

if (PCardinal(LVSBHead+$1C)^=CharsToNum('FAKE')) then
  DSDisposePtr(Ptr(LVSBHead))
  else UnloadCIN(LVSBHead);

If RTE then Writeln(DbgFile,'-----PURGE CIN END-----') else
 DbgPrintf('-----PURGE CIN END-----');
//
end;

procedure ShowGlobalList; cdecl;
var i: integer;
    pth: string;
begin
for i:=0 to GlobalSubNames.Count-1 do begin
pth := StringReplace(GlobalSubPaths[i],'\','\\',[rfReplaceAll]);

If RTE then Writeln(DbgFile,Format('"'+GlobalSubNames[i]+'" (0x%x) [parent="'+
                 GlobalParents[i]+'", path="'+pth+'", offset='+
                 GlobalOffsets[i]+']',[StrToInt(GlobalLVSBs[i])])) else
DbgPrintf_Format(pchar('"'+GlobalSubNames[i]+'" (0x%x) [parent="'+
                 GlobalParents[i]+'", path="'+pth+'", offset='+
                 GlobalOffsets[i]+']'),
                 StrToInt(GlobalLVSBs[i]));
end;
If RTE then Flush(DbgFile);
end;

exports ShowGlobalList name 'ShowGlobalList';

procedure DLLEntryPoint(Reason: DWORD);
var A: PCardinal;
    B: PByte;
    i, poffset, LIsb, LowerLimit, UpperLimit, ThisLibInstance, Return: cardinal;
    found: boolean;
    LVHeader: PImageOptionalHeader;
    LVInstanceName: string;
    const SearchSeq : Array[0..8] of byte =
    ($C7,$45,$FC,$69,$33,$38,$36,$FF,$D2);
    const SearchSeq2 : Array[0..6] of byte =
    ($81,$78,$08,$43,$49,$4E,$20);
    const SearchSeq3 : Array[0..8] of byte = //for PurgeCIN
    ($68,$4C,$56,$53,$42,$FF,$D0,$8B,$C8);
    const SearchSeq4 : Array[0..3] of byte = //for PurgeCIN
    ($43,$49,$4E,$20);
begin
case Reason of
DLL_PROCESS_ATTACH: begin
LVInstance := GetModuleHandle(nil);

//If (LVInstance<>0) then begin
SetLength(LVInstanceName, MAX_PATH);
Return:=GetModuleFileName(LVInstance, @LVInstanceName[1], MAX_PATH);
SetLength(LVInstanceName, Return);
//LVInstanceName := ChangeFileExt(ExtractFileName(LVInstanceName), '');
If (ChangeFileExt(ExtractFileName(LVInstanceName), '')<>'LabVIEW') then begin
  LVInstance := GetModuleHandle('lvrt.dll');
  SetLength(LVInstanceName, MAX_PATH);
  Return:=GetModuleFileName(LVInstance, @LVInstanceName[1], MAX_PATH);
  SetLength(LVInstanceName, Return);
  RTE:=True;
  //create new debug file for errors
  ThisLibInstance := GetModuleHandle('lvsb.dll');
  SetLength(DbgFilePath, MAX_PATH);
  Return:=GetModuleFileName(ThisLibInstance, @DbgFilePath[1], MAX_PATH);
  SetLength(DbgFilePath, Return);
  DbgFilePath := ExtractFilePath(DbgFilePath)+'lvsb_debug.txt';
  AssignFile(DbgFile, DbgFilePath);
  {$I-}
  repeat
  Rewrite(DbgFile);
  until (IOResult=0);
  {$I+}
end;
If (LVInstance<>0) then begin
  DbgPrintf := GetProcAddress(LVInstance, 'DbgPrintf');
  DbgPrintf_Format := @DbgPrintf;
  DbgPrintf_PStr := @DbgPrintf;
  MoveBlock := GetProcAddress(LVInstance, 'MoveBlock');
  SPrintf := GetProcAddress(LVInstance, 'SPrintf');
  //AZCheckPtr := GetProcAddress(LVInstance, 'AZCheckPtr');
  DSGetHandleSize := GetProcAddress(LVInstance, 'DSGetHandleSize');
  DSNewPtr := GetProcAddress(LVInstance, 'DSNewPtr');
  DSNewPClr := GetProcAddress(LVInstance, 'DSNewPClr');
  DSDisposePtr := GetProcAddress(LVInstance, 'DSDisposePtr');
  DSCheckPtr := GetProcAddress(LVInstance, 'DSCheckPtr');
  DSNewHandle := GetProcAddress(LVInstance, 'DSNewHandle');
  DSDisposeHandle := GetProcAddress(LVInstance, 'DSDisposeHandle');
  DSRecoverHandle := GetProcAddress(LVInstance, 'DSRecoverHandle');
  RGetNamed := GetProcAddress(LVInstance, 'RGetNamed');
  RGet := GetProcAddress(LVInstance, 'RGet');
  RGetInfo := GetProcAddress(LVInstance, 'RGetInfo');
  ROpenFile := GetProcAddress(LVInstance, 'ROpenFile');
  RCloseFile := GetProcAddress(LVInstance, 'RCloseFile');
  RRelease := GetProcAddress(LVInstance, 'RRelease');
  RDetach := GetProcAddress(LVInstance, 'RDetach');
  RAdd := GetProcAddress(LVInstance, 'RAdd');
  gLVRTVersion := PChar(PCardinal(GetProcAddress(LVInstance, 'gLVRTVersion'))^);
  FEmptyPath := GetProcAddress(LVInstance, 'FEmptyPath');
  FFlattenPath := GetProcAddress(LVInstance, 'FFlattenPath');
  FUnFlattenPath := GetProcAddress(LVInstance, 'FUnFlattenPath');
  PathIsPseudoPath := GetProcAddress(LVInstance, 'PathIsPseudoPath');
  PseudoPathToPath := GetProcAddress(LVInstance, 'PseudoPathToPath');
  FDestroyPath := GetProcAddress(LVInstance, 'FDestroyPath');
  FTextToPath := GetProcAddress(LVInstance, 'FTextToPath');
  FNamePtr := GetProcAddress(LVInstance, 'FNamePtr');
  FAddPath := GetProcAddress(LVInstance, 'FAddPath');
  FDirName := GetProcAddress(LVInstance, 'FDirName');
  FIsEmptyPath := GetProcAddress(LVInstance, 'FIsEmptyPath');
  FPathCpy := GetProcAddress(LVInstance, 'FPathCpy');
  OneButtonAlert := GetProcAddress(LVInstance, 'OneButtonAlert');
  ExtFileDialog := GetProcAddress(LVInstance, 'ExtFileDialog');
  RevBL := GetProcAddress(LVInstance, 'RevBL');
  LVRTTable := Cardinal(GetProcAddress(LVInstance, 'LVRTTable'));
mgcore := GetModuleHandle(pchar('mgcore_SH_'+IntToStr(LVVersion)+'_0.dll'));
If (mgcore<>0) then begin
//RFReader_MapToObsoleteRsrcFile := GetProcAddress(mgcore, '?MapToObsoleteRsrcFile@RFReader@@UAEKXZ');
RFReadWrite_Remove := GetProcAddress(mgcore, '?Remove@RFReadWrite@@QAEJW4_ResourceType@@J@Z');
RFReadWrite_LowLevelResFile := GetProcAddress(mgcore, '?LowLevelResFile@RFReadWrite@@QAEAAVResFile@@XZ');
LVResFile_RGet := GetProcAddress(mgcore, '?RGet@LVResFile@@UAEJW4_ResourceType@@JPAPAVResource@@@Z');
LVResource_RGetInfo := GetProcAddress(mgcore, '?RGetInfo@LVResource@@UBEJPAJPAW4_ResourceType@@PAE@Z');
end
else
 If RTE then Writeln(DbgFile,'mgcore_SH_'+IntToStr(LVVersion)+'_0.dll not found!')
 else DbgPrintf(pchar('mgcore_SH_'+IntToStr(LVVersion)+'_0.dll not found!'));

LVHeader := PImageOptionalHeader(pointer(integer(LVInstance) +
            PImageDosHeader(LVInstance)._lfanew + SizeOf(DWORD) +
            SizeOf(TImageFileHeader)));
If RTE then begin
Writeln(DbgFile,'Working in '+LVInstanceName);
//showmessage(Format('CodeBase is 0x%x',[LVHeader.BaseOfCode]));
Writeln(DbgFile,Format('CodeBase is 0x%x',[LVHeader.BaseOfCode]));
Writeln(DbgFile,Format('CodeSize is 0x%x',[LVHeader.SizeOfCode]));
end
else begin
DbgPrintf(pchar('Working in '+LVInstanceName));
DbgPrintf_Format(pchar('CodeBase is 0x%x'),LVHeader.BaseOfCode);
DbgPrintf_Format(pchar('CodeSize is 0x%x'),LVHeader.SizeOfCode);
end;
LowerLimit := LVInstance + LVHeader.BaseOfCode;
UpperLimit := LowerLimit + LVHeader.SizeOfCode - 1;
found:=false; i:=0;
LIsb := CharsToNum('LIsb');

//patching first sequence
while (not found) and (LowerLimit+i <= UpperLimit) do begin
i:=i+1;
A := Ptr(LowerLimit+i);
if Assigned(A) then
 //if A^ = $6273494C then found:=true; //string "LIsb"
 if A^ = LIsb then found:=true;
end;
if found then begin
PatchAddress_First := LowerLimit+i+13;
If RTE then begin
Writeln(DbgFile,Format('Found First offset: 0x%x',[LowerLimit+i]));
Writeln(DbgFile,Format('ProcessExternal proc is 0x%x',[cardinal(@ProcessExternal)]));
end
else begin
DbgPrintf_Format(pchar('Found First offset: 0x%x'),LowerLimit+i);
DbgPrintf_Format(pchar('ProcessExternal proc is 0x%x'),cardinal(@ProcessExternal));
end;

WriteBytesWithBackup(ptr(PatchAddress_First), PatchReload_First, Backup_First);
//ProcessExternalAddress := @ProcessExternal; //pointer to ProcessExternal func
   {
//write pointer address to byte array (PatchReload_Second)
PatchReload_Second[15] := Hi(Cardinal(@ProcessExternalAddress) shr 16);
PatchReload_Second[14] := Lo(Cardinal(@ProcessExternalAddress) shr 16);
PatchReload_Second[13] := Lo(Cardinal(@ProcessExternalAddress) shr 8);
PatchReload_Second[12] := Lo(Cardinal(@ProcessExternalAddress));

If RTE then PatchAddress := LowerLimit+i-376 else
 PatchAddress := LowerLimit+i-425;
WriteBytes(ptr(PatchAddress), PatchReload_Second);
}
end;
//end of patching

//patching second sequence
found:=false; i:=0;
while (not found) and (LowerLimit+i <= UpperLimit) do begin
i:=i+1;
A := Ptr(LowerLimit+i);
if Assigned(A) then
 if CompareMem(A,@SearchSeq2[0],7) then found:=true;
end;
if found then begin
If RTE then Writeln(DbgFile,Format('Found Second offset: 0x%x',[LowerLimit+i])) else
 DbgPrintf_Format(pchar('Found Second offset: 0x%x'),LowerLimit+i);
PatchAddress_Second := LowerLimit+i-3;
ProcessExternalAddress := @ProcessExternal; //pointer to ProcessExternal func

//write pointer address to byte array (PatchReload_Second)
if RTE then begin
PatchReload_Second_RTE[15] := Hi(Cardinal(@ProcessExternalAddress) shr 16);
PatchReload_Second_RTE[14] := Lo(Cardinal(@ProcessExternalAddress) shr 16);
PatchReload_Second_RTE[13] := Lo(Cardinal(@ProcessExternalAddress) shr 8);
PatchReload_Second_RTE[12] := Lo(Cardinal(@ProcessExternalAddress));

WriteBytesWithBackup(ptr(PatchAddress_Second), PatchReload_Second_RTE, Backup_Second_RTE);
end
else begin
PatchReload_Second[15] := Hi(Cardinal(@ProcessExternalAddress) shr 16);
PatchReload_Second[14] := Lo(Cardinal(@ProcessExternalAddress) shr 16);
PatchReload_Second[13] := Lo(Cardinal(@ProcessExternalAddress) shr 8);
PatchReload_Second[12] := Lo(Cardinal(@ProcessExternalAddress));

WriteBytesWithBackup(ptr(PatchAddress_Second), PatchReload_Second, Backup_Second);
end;
end
else
If RTE then Writeln(DbgFile,'Second offset not found!') else
 DbgPrintf('Second offset not found!');
//end of patching

//patching Save option
found:=false; i:=0;
while (not found) and (LowerLimit+i <= UpperLimit) do begin
i:=i+1;
A := Ptr(LowerLimit+i);
if Assigned(A) then
 if CompareMem(A,@SearchSeq[0],9) then found:=true;
end;
if found then begin
If RTE then Writeln(DbgFile,Format('Found Save offset: 0x%x',[LowerLimit+i])) else
 DbgPrintf_Format(pchar('Found Save offset: 0x%x'),LowerLimit+i);
PatchAddress_ForSave := LowerLimit+i-33;
SaveCINAddress := @SaveCIN; //pointer to SaveCIN func

//write pointer address to byte array (PatchReload_ForSave)
PatchReload_ForSave[20] := Hi(Cardinal(@SaveCINAddress) shr 16);
PatchReload_ForSave[19] := Lo(Cardinal(@SaveCINAddress) shr 16);
PatchReload_ForSave[18] := Lo(Cardinal(@SaveCINAddress) shr 8);
PatchReload_ForSave[17] := Lo(Cardinal(@SaveCINAddress));

WriteBytesWithBackup(ptr(PatchAddress_ForSave), PatchReload_ForSave, Backup_ForSave);
end
else
If RTE then Writeln(DbgFile,'Save offset not found!') else
 DbgPrintf('Save offset not found!');

//patching Purge option
found:=false; i:=0;
while (not found) and (LowerLimit+i <= UpperLimit) do begin
i:=i+1;
A := Ptr(LowerLimit+i);
if Assigned(A) then
 if CompareMem(A,@SearchSeq3[0],9) then found:=true;
end;
if found then begin //1
If RTE then Writeln(DbgFile,Format('Found Purge offset: 0x%x',[LowerLimit+i])) else
 DbgPrintf_Format(pchar('Found Purge offset: 0x%x'),LowerLimit+i);
PatchAddress_ForPurge := LowerLimit+i-11;
PurgeCINAddress := @PurgeCIN; //pointer to PurgeCIN func

//write pointer address to byte array (PatchReload_ForSave)

PatchReload_ForPurge[16] := Hi(Cardinal(@PurgeCINAddress) shr 16);
PatchReload_ForPurge[15] := Lo(Cardinal(@PurgeCINAddress) shr 16);
PatchReload_ForPurge[14] := Lo(Cardinal(@PurgeCINAddress) shr 8);
PatchReload_ForPurge[13] := Lo(Cardinal(@PurgeCINAddress));

WriteBytesWithBackup(ptr(PatchAddress_ForPurge), PatchReload_ForPurge, Backup_ForPurge);

//apply second patch

//go up and search for first CALL function
found:=false; i:=PatchAddress_ForPurge-LowerLimit;
while (not found) and (i>0) do begin
i:=i-1;
B := Ptr(LowerLimit+i);
if Assigned(B) then
 if (B^ = $E8) then found:=true;
end;
if found then begin //2
poffset := LowerLimit+i;

//go up and search for "CIN " string test
found:=false; //i:=PatchAddress_ForPurge-LowerLimit;
while (not found) and (i>0) do begin
i:=i-1;
A := Ptr(LowerLimit+i);
if Assigned(A) then
 if CompareMem(A,@SearchSeq4[0],4) then found:=true;
end;
if found then begin //3
If RTE then Writeln(DbgFile,Format('Found Purge offset 2: 0x%x',[LowerLimit+i])) else
 DbgPrintf_Format(pchar('Found Purge offset 2: 0x%x'),LowerLimit+i);
PatchAddress_ForPurge2 := LowerLimit+i+6;
poffset := poffset - (PatchAddress_ForPurge2+4);
PatchReload_ForPurge2[3] := Hi(poffset shr 16);
PatchReload_ForPurge2[2] := Lo(poffset shr 16);
PatchReload_ForPurge2[1] := Lo(poffset shr 8);
PatchReload_ForPurge2[0] := Lo(poffset);
WriteBytesWithBackup(ptr(PatchAddress_ForPurge2), PatchReload_ForPurge2, Backup_ForPurge2);
end //end to if found 3
else
If RTE then Writeln(DbgFile,'Purge offset 2 not found!') else
 DbgPrintf('Purge offset 2 not found!');
end //end to if found 2
else
If RTE then Writeln(DbgFile,'Purge first call not found!') else
 DbgPrintf('Purge first call not found!');
end //end to if found 1
else
If RTE then Writeln(DbgFile,'Purge offset not found!') else
 DbgPrintf('Purge offset not found!');

GlobalSubNames:=TStringList.Create;
GlobalSubNames.CaseSensitive := false;
GlobalLVSBs:=TStringList.Create;
GlobalLVSBs.CaseSensitive := false;
GlobalParents:=TStringList.Create;
GlobalParents.CaseSensitive := false;
GlobalSubPaths:=TStringList.Create;
GlobalSubPaths.CaseSensitive := false;
GlobalOffsets:=TStringList.Create;
GlobalOffsets.CaseSensitive := false;

If RTE then Flush(DbgFile);
end; // If (LVInstance<>0)
//end; // If (LVInstance<>0)
end; // DLL_PROCESS_ATTACH
DLL_THREAD_ATTACH:
begin
//MessageBox(0, 'Подключение потока', 'Инфо', mb_Ok);
end;
DLL_THREAD_DETACH:
begin
//MessageBox(0, 'Отключение потока', 'Инфо', mb_Ok);
end;
DLL_PROCESS_DETACH:
begin
GlobalSubNames.Free;
GlobalLVSBs.Free;
GlobalParents.Free;
GlobalSubPaths.Free;
GlobalOffsets.Free;
If RTE then CloseFile(DbgFile);
//restore LV data
WriteBytes(ptr(PatchAddress_First), Backup_First);
WriteBytes(ptr(PatchAddress_Second), Backup_Second);
WriteBytes(ptr(PatchAddress_ForSave), Backup_ForSave);
WriteBytes(ptr(PatchAddress_ForPurge), Backup_ForPurge);
WriteBytes(ptr(PatchAddress_ForPurge2), Backup_ForPurge2);
end;
end; //case Reason of
end; //proc

begin
DllProc := @DLLEntryPoint;
DllProc(DLL_PROCESS_ATTACH);
end.