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);

  TVadSecureEntry = Record
    StartingVpn : Int64;
    EndingVpn : Int64;
    ReadOnly : Boolean;
    end;
  PVadSecureEntry = ^TVadSecureEntry;

  // 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;
    SecureEntryCount : DWORD;
    SecureEntries : Array [0..1] Of TVadSecureEntry;
    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;
Procedure FreeVadRecord(VadRecord:PVadRecord);
Procedure FreeVadRecordList(AList:TList; AFreeList:Boolean = True);

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.
}
Var
  I : Integer;
begin
V.SecureEntryCount := 0;
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;
If (IsWindowsVista) Or (IsWindows7) Then
  begin
  V.PreferredMode := (R.Flags3 And VAD_FLAGS3_PREFERREDMODE);
  V.Teb := (R.Flags3 And VAD_FLAGS3_TEB) > 0;
  end;

If R.SecureInfo.EntryCount > 0 Then
  begin
  V.SecureEntryCount := R.SecureInfo.EntryCount;
  For I := 0 To R.SecureInfo.EntryCount - 1 Do
    begin
    V.SecureEntries[I].StartingVpn := R.SecureInfo.Entries[I].StartingVpn;
    V.SecureEntries[I].EndingVpn := R.SecureInfo.Entries[I].EndingVpn;
    V.SecureEntries[I].ReadOnly := R.SecureInfo.Entries[I].ReadOnly <> 0;
    end;
  end;
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.
}

  Function VadRecordCompare(Vad1:Pointer; Vad2:Pointer):Integer;
  Var
    Res : Int64;
  begin
  Res := PVadRecord(Vad1).StartAddress - PVadRecord(Vad2).StartAddress;
  If Res < 0 Then
    Result := -1
  Else If Res > 0 Then
    Result := 1
  Else Result := 0;
  end;

Var
  I : Integer;
  VR : PVadRecord;
  VadList : PVAD_LIST;
  BufferSize : DWORD;
  UMVadRecord : PUM_VAD_RECORD;
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
  UmVadRecord := PUM_VAD_RECORD(NativeInt(VadList) + sizeOf(Int64));
  For I := 0 To VadList.Count - 1 Do
    begin
    VR := MemAlloc(SizeOf(TVadRecord) + SizeOf(TVadSecureEntry)*UmVadRecord.SecureInfo.EntryCount);
    Result := Assigned(VR);
    If Result Then
      begin
      RoughVadRecordToVadRecord(UmVadRecord, VR);
      List.Add(VR);
      UmVadRecord := PUM_VAD_RECORD(NativeInt(UmVadRecord) + UmVadRecord.Length);
      end Else Break;
    end;
  end;

If Assigned(VadList) Then
  MemFree(VadList);

If Result Then
  List.Sort(@VadRecordCompare);
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 := 'VadlargePageSection';
  Else Result := '<Neznamy>';
  end;
end;

Procedure FreeVadRecord(VadRecord:PVadRecord);
begin
MemFree(VadRecord);
end;

Procedure FreeVadRecordList(AList:TList; AFreeList:Boolean = True);
Var
  I : Integer;
begin
For I := 0 To AList.Count - 1 Do
  FreeVadRecord(AList[I]);

If AFreeList Then
  AList.Free
Else AList.Clear;
end;


End.

