Strides Logger [Delphi]

For the delphi developer wanting to make custom chams, this tool will help in finding the strides, Hooks not included....

Screenshot

Usage:
Insert - Logger Off/On
Arrow Up/Down - Navigate
Arrow Left/Right - Decrease/Increase Value Of Selected Item
NumberPad 7 - Strides Off/On
NumberPad 8 - Nums Off/On
NumberPad 9 - Prims Off/On

Code

Code:

var
  //LogThread Handle
  dwPresent: Cardinal = 0;
  dwReset: Cardinal = 0;
  dwDIP  : Cardinal = 0;
  dwThrdLog: Dword = 0;
  dwThrdMain: Dword = 0;
  bColorsSet: Boolean = False;
  texRed: IDIRECT3DTEXTURE9;
  pD3Ddev:  IDirect3DDevice9;

  iItem: Integer = 0;

  cStride: Cardinal = 0;
  cNums: LongWord = 0;
  cPrims: LongWord = 0;

  bMenuOn: Boolean = True;
  bStride: Boolean = False;
  bNums: Boolean = False;
  bPrims: Boolean = False;

  MenuFont: D3DX9.ID3DXFont;

  ResetNext     : function(const Self: IDirect3DDevice9; const PPresentationParameters:_D3DPRESENT_PARAMETERS_):HResult;stdcall = nil;
  DrawIndexedPrimitiveNext: function(const Self: IDirect3DDevice9; _Type: TD3DPrimitiveType; BaseVertexIndex: Integer; MinVertexIndex, NumVertices, startIndex, primCount: LongWord): HResult; stdcall = nil;
  PresentNext   : function(const Self: IDirect3DDevice9; pSourceRect, pDestRect: PRect; hDestWindowOverride: HWND; pDirtyRegion: PRgnData): HResult; stdcall = nil;

const
  aRed: array[1..60] of Byte = ($42, $4D, $3C, $00, $00, $00, $00, $00, $00, $00, $36, $00, $00, $00, $28, $00, $00, $00, $01, $00, $00, $00, $01, $00, $00, $00, $01, $00, $20, $00, $00, $00, $00, $00, $00, $00, $00, $00, $12, $0B, $00, $00, $12, $0B, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $FF, $00, $00, $00);


  Function LogThread():Dword;

implementation

Function GetDevice():IDirect3DDevice9;
begin
  Result:= pD3Ddev;
end;

//Returns the Font Interface
function GetFont(): ID3DXFont;
begin
  Result:= MenuFont;
end;

procedure MenuInt(pDevice: IDirect3DDevice9);
begin
 if GetDevice <>  pDevice then
   begin
    pD3Ddev:= pDevice;
    MenuFont:= nil;
    if GetFont = nil then
     D3DXCreateFont(pDevice,10, 0, FW_BOLD, 1, FALSE, DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH or FF_DONTCARE, 'Terminal', MenuFont);
   end;
end;

procedure DrawTextA(const iLeft, iTop: Integer; szText: PAnsiChar; Color: D3DCOLOR);
var
  d3dRectangle : D3DRECT;
begin
  d3dRectangle.x1:= ileft;
  d3dRectangle.y1:= itop;
  d3dRectangle.x2:= ileft + 100;
  d3dRectangle.y2:= itop + 10;

  GetFont.DrawTextA(nil, szText, -1, @D3DRectangle, 0{( DT_CALCRECT or DT_NOCLIP )}, Color);
end;

Function DrawIndexedPrimitiveCallback(const Self: IDIRECT3DDEVICE9; _Type: TD3DPrimitiveType; BaseVertexIndex: Integer; MinVertexIndex, NumVertices, startIndex, primCount: LongWord): HResult; stdcall;
var
 Stream_Data: IDIRECT3DVERTEXBUFFER9;
 Offset: cardinal;
 Stride: cardinal;
begin
   asm
    PUSHAD
   end;

   if bColorsSet = False then
    begin
     D3DXCreateTextureFromFileInMemory(Self, @Ared, sizeof(aRed), texRed);
     bColorsSet:= True;
    end;

     Self.GetStreamSource(0, Stream_Data, Offset, Stride);
    if bStride then
     if Stride = cStride then
      begin
       //Texture
       Self.SetTexture(1,nil);
       Self.SetTexture(0, texRed);
       Self.SetRenderState(D3DRS_ZENABLE, D3DZB_FALSE);
       DrawIndexedPrimitiveNext(Self, _Type, BaseVertexIndex, MinVertexIndex, NumVertices, startIndex, primCount);
       Self.SetTexture(0, texRed);
       Self.SetRenderState(D3DRS_ZENABLE, D3DZB_TRUE);
      end;

    if ((bStride = True) and (bNums = True)) then
     if ((Stride = cStride) and (NumVertices = cNums)) then
      begin
       //Texture
       Self.SetTexture(1,nil);
       Self.SetTexture(0, texRed);
       Self.SetRenderState(D3DRS_ZENABLE, D3DZB_FALSE);
       DrawIndexedPrimitiveNext(Self, _Type, BaseVertexIndex, MinVertexIndex, NumVertices, startIndex, primCount);
       Self.SetTexture(0, texRed);
       Self.SetRenderState(D3DRS_ZENABLE, D3DZB_TRUE);
      end;

    if ((bStride = True) and (bNums = True) and (bPrims = True)) then
     if ((Stride = cStride) and (NumVertices = cNums) and (primCount = cPrims)) then
      begin
       //Texture
       Self.SetTexture(1,nil);
       Self.SetTexture(0, texRed);
       Self.SetRenderState(D3DRS_ZENABLE, D3DZB_FALSE);
       DrawIndexedPrimitiveNext(Self, _Type, BaseVertexIndex, MinVertexIndex, NumVertices, startIndex, primCount);
       Self.SetTexture(0, texRed);
       Self.SetRenderState(D3DRS_ZENABLE, D3DZB_TRUE);
      end;

    if bNums = True then
     if NumVertices = cNums then
      begin
       //Texture
       Self.SetTexture(1,nil);
       Self.SetTexture(0, texRed);
       Self.SetRenderState(D3DRS_ZENABLE, D3DZB_FALSE);
       DrawIndexedPrimitiveNext(Self, _Type, BaseVertexIndex, MinVertexIndex, NumVertices, startIndex, primCount);
       Self.SetTexture(0, texRed);
       Self.SetRenderState(D3DRS_ZENABLE, D3DZB_TRUE);
      end;

  asm
   POPAD
  end;

  Result:= DrawIndexedPrimitiveNext(Self, _Type, BaseVertexIndex, MinVertexIndex, NumVertices, startIndex, primCount);
end;


function ResetCallBack(const Self:IDirect3DDevice9; const PPresentationParameters:_D3DPRESENT_PARAMETERS_):HRESULT;stdcall;
begin
  asm
   nop
  end;

  MenuFont.OnLostDevice;
  MenuFont.OnResetDevice;
  bColorsSet:= False;
  result := ResetNext(self,PPresentationParameters);
end;

function PresentCallBack(const Self: IDirect3DDevice9; pSourceRect, pDestRect: PRect; hDestWindowOverride: HWND; pDirtyRegion: PRgnData): HResult; stdcall;
begin
   asm
    pushad
   end;
   if bMenuOn then
   begin
   //Render Menu
   MenuInt(Self);
   GetDevice.SetRenderState( D3DRS_SRCBLEND, D3DBLEND_SRCALPHA );
	 GetDevice.SetRenderState( D3DRS_BLENDOP, D3DBLENDOP_ADD );
	 GetDevice.SetRenderState( D3DRS_DESTBLEND, D3DBLEND_INVSRCALPHA );
	 GetDevice.SetRenderState( D3DRS_ALPHATESTENABLE, 0 );
	 GetDevice.SetRenderState( D3DRS_SEPARATEALPHABLENDENABLE, 0 );
	 GetDevice.SetRenderState( D3DRS_STENCILENABLE, 0 );
	 GetDevice.SetRenderState( D3DRS_ALPHABLENDENABLE, 0 );
	 GetDevice.SetRenderState( D3DRS_VERTEXBLEND, D3DVBF_DISABLE );
	 GetDevice.SetRenderState( D3DRS_INDEXEDVERTEXBLENDENABLE, 0 );
	 GetDevice.SetRenderState( D3DRS_COLORWRITEENABLE, D3DCOLORWRITEENABLE_ALPHA or D3DCOLORWRITEENABLE_BLUE or D3DCOLORWRITEENABLE_GREEN or D3DCOLORWRITEENABLE_RED );
	 GetDevice.SetRenderState( D3DRS_SHADEMODE, D3DSHADE_GOURAUD );
	 GetDevice.SetRenderState( D3DRS_FOGENABLE, 0 );
	 GetDevice.SetRenderState( D3DRS_SPECULARENABLE, 0 );
	 GetDevice.SetRenderState( D3DRS_LIGHTING, 0 );
	 GetDevice.SetRenderState( D3DRS_CULLMODE, D3DCULL_NONE );
	 GetDevice.SetRenderState( D3DRS_ZWRITEENABLE, 0 );
	 GetDevice.SetRenderState( D3DRS_ZENABLE, 0 );
	 GetDevice.SetRenderState( D3DRS_FILLMODE, D3DFILL_SOLID );

   if bStride then
    DrawTextA(20, 20, PChar('Stride: ' + IntToStr(cStride)), $FF0676CD)
   else
    DrawTextA(20, 20, PChar('Stride: ' + IntToStr(cStride)), $FFFF0000);

   if bNums then
    DrawTextA(20, 30, PChar('NumVertices: ' + IntToStr(cNums)), $FF0676CD)
   else
    DrawTextA(20, 30, PChar('NumVertices: ' + IntToStr(cNums)), $FFFF0000);

   if bPrims then
    DrawTextA(20, 40, PChar('PrimCount: ' + IntToStr(cPrims)), $FF0676CD)
   else
    DrawTextA(20, 40, PChar('PrimCount: ' + IntToStr(cPrims)), $FFFF0000);

   case iItem of
   0:begin
     if bStride then
      DrawTextA(8, 20, PChar('>>'), $FF0676CD)
     else
      DrawTextA(8, 20, PChar('>>'), $FFFF0000);
    end;

   1:begin
     if bNums then
      DrawTextA(8, 30, PChar('>>'), $FF0676CD)
     else
      DrawTextA(8, 30, PChar('>>'), $FFFF0000);
    end;

   2:begin
      if bPrims then
       DrawTextA(8, 40, PChar('>>'), $FF0676CD)
      else
       DrawTextA(8, 40, PChar('>>'), $FFFF0000);
     end;
   end;

   end;

   asm
    popad
   end;

   Result := PresentNext( Self,pSourceRect, pDestRect, hDestWindowOverride,pDirtyRegion);
end;

Function IsGameReadyForHook: Boolean;
var
  null: variant;
begin

 if (GetModuleHandleA('d3d9.dll') <> null) then
  begin
    Result := True;
  end
  else
    Result := False;
end;

function FuncMain(const LPVOID: variant): Boolean;
begin
  while (True) do
   begin

    asm
     pushad;
    end;

    //Hide Show Stride Logger
    if (GetAsyncKeyState(VK_INSERT) <> 0) then
    begin
     bMenuOn:= Not bMenuOn;
     Sleep(100);
    end;

    //Strides On/Off
    if (GetAsyncKeyState(VK_NUMPAD7) <> 0) then
    begin
     bStride:= Not bStride;
     Sleep(100);
    end;

   //Strides On/Off
    if (GetAsyncKeyState(VK_NUMPAD8) <> 0) then
    begin
     bNums:= Not bNums;
     Sleep(100);
    end;

   //Strides On/Off
    if (GetAsyncKeyState(VK_NUMPAD9) <> 0) then
    begin
     bPrims:= Not bPrims;
     Sleep(100);
    end;

    //Increase Menu Item
    if (GetAsyncKeyState(VK_RIGHT) <> 0) then
    begin
    case iItem of
     0:begin Inc(cStride); end;
     1:begin Inc(cNums); end;
     2:begin Inc(cPrims); end;
    end;
    end;
    //Decrease Menu Item
    if (GetAsyncKeyState(VK_LEFT) <> 0) then
    begin
     case iItem of
      0:begin Dec(cStride); end;
      1:begin Dec(cNums); end;
      2:begin Dec(cPrims); end;
     end;
    end;

    if (GetAsyncKeyState(VK_UP) <> 0) then
    begin
     if iItem = 0 then
      iItem:= 2
     else
      Dec(iItem);
     Sleep(100);
    end;

    if (GetAsyncKeyState(VK_Down) <> 0) then
    begin
     if iItem = 2 then
      iItem:= 0
     else
      Inc(iItem);
     Sleep(100);
    end;

    Sleep(50);

    asm
     popad;
    end;

  end;
end;

Function LogThread():Dword;
begin
 Repeat
    Sleep(500);
  Until ((IsGameReadyForHook = True) and (dwThrdMain = 0));
  dwPresent:= GetD3d9Vtable(17);
  dwReset:= GetD3d9Vtable(16);
  dwDip:= GetD3d9Vtable(82);

 if (Hook(Pointer(dwPresent) , @presentCallBack, @presentNext) and
     Hook(Pointer(dwReset) , @ReSeTCallBack, @ReSeTNext) and
     Hook(Pointer(dwDip) , @drawIndexedPrimitiveCallback, @drawIndexedPrimitiveNext))
  then
  begin
   CreateThread(nil, 0, @FuncMain, nil, 0, dwThrdMain);
   messagebox(0,Pchar('Hooked'),Pchar('hookedy'), mb_ok);
  end;

 Result:= 0;

end;

end.