Unit VadLib;

{
  Cast knihovny pro praci s virtualnimi deskriptory
  pro aplikace bezici v uzivatelskem rezimu.

  Knihovna pomoci komunikace s ovladacem vad.sys dovoluje
  ziskavat informace o virtualnich deskriptorech daneho
  procesu.
}

Interface

Uses
  Windows, Classes;

Type
  // Typ virtualniho deskriptoru. Deklarace je
  // konzistentni s deklaraci v ovladaci vad.sys..
  TVadType = (VadNone, VadDevicePhysicalMemory,
      VadImageMap, VadAwe, VadWriteWatch,
      VadLargePages, VadRotatePhysical,
      VadLargePageSection);

  // Typ struktury virtualniho deskriptoru.
  // Deklarace je konzistentni s ovladacem vad.sys.
  TVadStructureType = (vstUnknown, vstShort, vstNormal,
      vstLong, vstMapped);

  // Definice zaznamu s informacemi o jednom virtualnim
  // deskriptoru
  TVadRecord = Record
    StartAddress : Int64;
    EndAddress : Int64;
    VadType : TVadType;
    VadStructureType : TVadStructureType;
    NoChange : Boolean;
    MemCommit : Boolean;
    Protection : DWORD;
    PrivateMemory : Boolean;
    FileOffset : Int64;
    SecNoChange : Boolean;
    OneSecured : Boolean;
    MultipleSecured : Boolean;
    ReadOnly : Boolean;
    LongVad : Boolean;
    Extendable : Boolean;
    Inherit : Boolean;
    CopyOnWrite : Boolean;
    PreferredMode : DWORD;
    Teb : Boolean;
    CommitCharge : Int64;
    end;
  PVadRecord = ^TVadRecord;

Function VadLibInit:Boolean;
Procedure VadLibFinit;
Function VadLibGetVadListForProcess(PID:DWORD; List:TList):Boolean;
Function VadLibVadStructureToStr(T:TVadStructureType):WideString;
Function VadLibVadTypeToStr(T:TVadType):WideString;

Implementation

Uses
  DriverCommands, SysUtils, Utils;

Function VadLibInit:Boolean;
{
  Inicializuje knihovnu. To spociva v instalaci ovladace vad.sys,
  jeho nacteni do pameti jadra a pripojeni na jeho komunikacni
  zarizeni.
}
begin
Result := VadDriverInit;
If Result Then
  begin
  Result := VadDriverLoad;
  If Not Result Then
    VadDriverFinit;
  end;
end;

Procedure VadLibFinit;
{
  Odstrani ovladac vad.sys z pameti jadra a odinstaluje jeho
  sluzbu. Rutina je parova k VadLibInit.
}
begin
VadDriverUnload;
VadDriverFinit;
end;

Procedure RoughVadRecordToVadRecord(R:PUM_VAD_RECORD; V:PVadRecord);
{
  Prevede zaznam UM_VAD_RECORD pouzivany ovladacem vad.sys pro ulozeni
  informaci o jednom virtualnim deskriptoru na zaznam TVadRecord.
}
begin
V.StartAddress := R.StartAddress;
V.EndAddress := R.EndAddress;
V.VadType := TVadType(R.VadType);
V.VadStructureType := TVadStructureType(R.StructureType);
// Vyznam konkretnich bitu v prvni skupine priznaku je zavisly na
// platforme
If (GetOSType = ost32bit) Then
  begin
  V.CommitCharge := (R.Flags1 And VAD_FLAGS1_COMMITCHARGE_X86) * $1000;
  V.NoChange := (R.Flags1 And VAD_FLAGS1_NOCHANGE_X86) > 0;
  V.MemCommit := (R.Flags1 And VAD_FLAGS1_MEMCOMMIT_X86) > 0;
  V.Protection := (R.Flags1 And VAD_FLAGS1_PROTECTION_X86) Div VAD_FLAGS1_PROTECTION_SHIFT_X86;
  V.PrivateMemory := (R.Flags1 And VAD_FLAGS1_PRIVATEMEMORY_X86) > 0;
  end
Else begin
  V.CommitCharge := (R.Flags1 And VAD_FLAGS1_COMMITCHARGE_X64) * $1000;
  V.NoChange := (R.Flags1 And VAD_FLAGS1_NOCHANGE_X64) > 0;
  V.MemCommit := (R.Flags1 And VAD_FLAGS1_MEMCOMMIT_X64) > 0;
  V.Protection := (R.Flags1 And VAD_FLAGS1_PROTECTION_X64) Div VAD_FLAGS1_PROTECTION_SHIFT_X64;
  V.PrivateMemory := (R.Flags1 And VAD_FLAGS1_PRIVATEMEMORY_X64) > 0;
  end;

V.FileOffset := (R.Flags2 And VAD_FLAGS2_FILEOFFSET);
V.SecNoChange := (R.Flags2 And VAD_FLAGS2_SECNOCHANGE) > 0;
V.OneSecured := (R.Flags2 And VAD_FLAGS2_ONESECURED) > 0;
V.MultipleSecured := (R.Flags2 And VAD_FLAGS2_MULTIPLESECURED) > 0;
V.ReadOnly := (R.Flags2 And VAD_FLAGS2_READONLY) > 0;
V.LongVad := (R.Flags2 And VAD_FLAGS2_LONGVAD) > 0;
V.Extendable := (R.Flags2 And VAD_FLAGS2_EXTENDABLE) > 0;
V.Inherit := (R.Flags2 And VAD_FLAGS2_INHERIT) > 0;
V.CopyOnWrite := (R.Flags2 And VAD_FLAGS2_COPYONWRITE) > 0;
V.PreferredMode := (R.Flags3 And VAD_FLAGS3_PREFERREDMODE);
V.Teb := (R.Flags3 And VAD_FLAGS3_TEB) > 0;
end;

Function VadLibGetVadListForProcess(PID:DWORD; List:TList):Boolean;
{
  Ziska seznam virtualnich deskriptoru pro proces zadany cislem PID.
  tento seznam ulozi to promenne List, ktera musi odkazovat na jiz
  vytvorenou instanci tridy TList.
}
Var
  I : Integer;
  VR : PVadRecord;
  VadList : PVAD_LIST;
  BufferSize : DWORD;
begin
BufferSize := 4096;
VadList := MemAlloc(BufferSize);
Result := Assigned(VadList);
While Result Do
  begin
  Result := VadDriverGetVadList(PID, VadList, BufferSize);
  If (Not Result) And (GetLastError = ERROR_INSUFFICIENT_BUFFER) Then
    begin
    MemFree(VadList);
    BufferSize := BufferSize * 2;
    VadList := MemAlloc(BufferSize);
    Result := Assigned(VadList);
    end Else Break;
  end;

If Result Then
  begin
  For I := 0 To VadList.Count - 1 Do
    begin
    VR := MemAlloc(SizeOf(TVadRecord));
    Result := Assigned(VR);
    If Result Then
      begin
      RoughVadRecordToVadRecord(@VadList.Items[I], VR);
      List.Add(VR);
      end Else Break;
    end;
  end;

If Assigned(VadList) Then
  MemFree(VadList);
end;

Function VadLibVadStructureToStr(T:TVadStructureType):WideString;
{
  Prevede konstantu typu struktury virtualniho deskriptoru na
  retezec.
}
begin
Case T Of
  vstShort : Result := 'Small';
  vstNormal : Result := 'Normal';
  vstLong : Result := 'Long';
  vstMapped : Result := 'Mapped';
  Else Result := '<Neznamy>';
  end;
end;

Function VadLibVadTypeToStr(T:TVadType):WideString;
{
  Prevede konstantu typu virtualniho deskriptoru na retezec
}
begin
Case T Of
  VadNone : Result := 'VadNone';
  VadDevicePhysicalMemory : Result := 'VadDevicePhysicalMemory';
  VadImageMap : Result := 'VadImageMap';
  VadAwe : Result := 'VadAwe';
  VadWriteWatch : Result := 'VadWriteWatch';
  VadLargePages : Result := 'VadLargePages';
  VadRotatePhysical : Result := 'VadRotatePhysical';
  VadLargePageSection : Result := 'VadlargePageEsction';
  Else Result := '<Neznamy>';
  end;
end;

end.

