Die Bilder zum Beitrag von Hannes Teich im Original - klicken um zu vergrößern.

Listings aus dem Artikel "Anzeigen von Strukturen" gepackt. Und entpackt:

\ =============
\ DUMPPEH.4TH
\ Das Programm
\ =============

DECIMAL

\ Die hier definierten Worte werden vorwiegend sofort ausgefuehrt.

warning off        \ nicht für Bigforth           
marker dumpmarker  \ Wegen den Redefinitionen, am Ende alles 'vergessen'.

\ ------------------------------------------------------------------------------
\ Kommentar über mehreren Zeilen für Bigforth.

: (( ( -- )
   BEGIN
     bl word dup @
     [ hex ffffff decimal ] literal and
     [ hex 292902 decimal ] literal <>
   WHILE
     c@ 0= IF refill drop THEN
   REPEAT
   drop
; immediate

\ ------------------------------------------------------------------------------
\ Definition der Strukturworte.

: structur
   CREATE here 0 , 0    \ ( "bname" -- dfa ofs=0 )
   DOES>  @             \ ( dfa -- nbytes )
   CREATE allot         \ ( "sname" nbytes -- )
;

: field                 \ ( "fname" ofs field.dfa -- ofs+fsize )
   CREATE over , +
   DOES> @ +            \ ( base dfa -- base+ofs )
;

: endstructur           \ ( dfa nbytes -- )
   swap !
;

\ ------------------------------------------------------------------------------
\ Redefinition der Strukturworte.

24 CONSTANT ntab      \ Tabulatorwert
0  VALUE fval         \ Aktueller Feld-Wert
0  VALUE ofsh         \ laufender Offset beim einlesen
0  VALUE defflag      \ -1 bei Redefinitionen

\ Konversion.
: >fstring ( string0 -- str len )
   0 BEGIN 2dup + c@ WHILE 1+ REPEAT
;

\ Sektionname ausgeben.
: .section_name ( string0 -- )
   >fstring 8 min 8 over - spaces type
;

\ Strukturname anzeigen.
: structur2 ( ccc<*> -- ) cr cr bl word count type ;

\ Feldwert in hex ausgeben, Sektion-Name ausgeben.
: field2 ( size -- )
   base @ swap hex
   bl word count dup >r cr type
   ntab r> - spaces
   ( size ) dup
   CASE
     1 OF  ofsh c@ dup to fval 8 u.r  ENDOF
     2 OF  ofsh w@ dup to fval 8 u.r  ENDOF
     4 OF  ofsh  @ dup to fval 8 u.r  ENDOF
     8 OF  ofsh .section_name         ENDOF
   DUP OF  8 spaces                   ENDOF
   ENDCASE
   2 spaces
   ( size ) ofsh + to ofsh
   base !
;

: endstructur2 ( -- )  noop ;

\ Sektion-Attribute anzeigen.
: attribute ( -- )
   [ hex ]
   fval 20000000 and IF  ." ausfuehren "  THEN
   fval 40000000 and IF  ." lesen "       THEN
   fval 80000000 and IF  ." schreiben "   THEN
   [ decimal ]
;

: rem ( -- ) source >in ! drop ;

\ Steuerung der Strukturworte, bedingtes Kommentarwort.
: structur     defflag IF structur2    ELSE structur    THEN ;
: field        defflag IF field2       ELSE field       THEN ;
: endstructur  defflag IF endstructur2 ELSE endstructur THEN ;
: \?           defflag IF noop         ELSE rem         THEN ;

\ Zum gezieltes 'include' der Strukturen, werden diese Worte spaeter mit
\ 'noop' oder 'rem' belegt.
DEFER doshdr
DEFER pehdr
DEFER sectionhdr
DEFER importhdr

\ ------------------------------------------------------------------------------
\ Struktur-Prototypen anlegen, Windows-Header laden und Zeiger setzen.

24   CONSTANT ntfile_size
40   CONSTANT section_size
1000 CONSTANT header_size    \ Programmkopf-Groesse
\
\ Basis der Strukturen
0 VALUE dos{}
0 VALUE ntfile{}
0 VALUE optional{}
0 VALUE section0{}
\
0 VALUE  peheader   \ vorhanden ( -1 )
0 VALUE  #section   \ Anzahl der Sektionen
0 VALUE  fid        \ Datei-Kennung

CREATE basepage header_size chars allot  \ Buffer

\ Fehlermeldungen.
: dumpend1 ( -- ) cr ." Datei nicht vorhanden" dumpmarker abort ;
: dumpend2 ( -- ) cr ." Kein Windows-Header vorhanden" dumpmarker abort ;

\ Kontrolle.
: ?openerror ( n -- )          IF  dumpend1  THEN ;
: ?winheader ( n -- ) $5a4d <> IF  dumpend2  THEN ;
: ?peheader  ( n -- ) $4550 <> IF  dumpend2  THEN ;

\ Struktur-Definition aktivieren.
\ alle Strukturen anlegen.
0 to defflag
' rem is doshdr
' rem is pehdr
' rem is sectionhdr
' rem is importhdr

\ Struktur-Prototypen anlegen.
includepath_pe INCLUDED

: windows_header_laden ( -- )
   path\name count r/o OPEN-FILE ?openerror to fid
   basepage header_size fid READ-FILE 2drop
   basepage to dos{}
   dos{} e_magic w@ ?winheader                  \ 'MZ' ?
   dos{} e_lfanew @ ( ofs )                     \ NTFILE_HEADER-Offset
   dup $100 u<
   IF
      ( ofs ) dos{} + to ntfile{}               \ NTFILE_HEADER-Basis
      ntfile{} Signature @ ?peheader            \ 'PE' ?
      -1 to peheader
      ntfile{} NumberOfSections w@ to #section  \ Anzahl der Sektionen
      ntfile{} ntfile_size + to optional{}      \ OPTIONAL_HEADER-Basis
      ntfile{} SizeOfOptionalHeader w@          \ OPTIONAL_HEADER-Laenge
      optional{} + to section0{}                \ SECTION_HEADER-Basis
   ELSE
      drop                                      \ DOS-Header
   THEN
;

windows_header_laden

\ ------------------------------------------------------------------------------
\ Strukturen mit redefinierten Worten nochmal laden. Sie werden jetzt angezeigt.

\ Index nach Adresse transformieren.
: section{} ( i -- adr ) section_size * section0{} + ;

\ Windows-Header anzeigen.
: .winheader ( -- )
   page
   -1 to defflag                  \ Struktur-Redefinition aktivieren
   peheader
   IF                             \ pe_header anzeigen
      ntfile{} to ofsh
      ['] rem  is pehdr
      ['] noop is doshdr
      ['] noop is sectionhdr
      ['] noop is importhdr
     includepath_pe INCLUDED
   ELSE                           \ dos_header anzeigen
      dos{} to ofsh
      ['] rem  is doshdr
      ['] noop is pehdr
      ['] noop is sectionhdr
      ['] noop is importhdr
      includepath_pe INCLUDED
      dumpmarker quit             \ Ende
   THEN
;

\ Sektionen anzeigen.
: .sections ( -- )
   peheader
   IF                             \ section_header anzeigen
      ['] rem  is sectionhdr
      ['] noop is pehdr
      ['] noop is doshdr
      ['] noop is importhdr
      #section 0
      DO
         i section{} to ofsh
         includepath_pe INCLUDED
      LOOP
   THEN
;

.winheader
.sections

\ ------------------------------------------------------------------------------
\ Sektion suchen, wo die Import-Funktionen liegen.

0 VALUE virtual_size      \ VirtualSize
0 VALUE virtual_address   \ VirtualAddress
0 VALUE raw_size          \ SizeOfRawData
0 VALUE raw_pointer       \ PointerToRawData

\ Die Adresse ImportDirectoryRva @ (Eintrag vom OPTIONAL_HEADER) muss zwischen
\ VirtualAddress und VirtualAddress+VirtualSize der Sektion liegen.

: search_importsection ( -- )
   #section 0
   DO
      i section{}
      dup SizeOfRawData @ to raw_size
      dup PointerToRawData @ to raw_pointer
      dup VirtualAddress @ to virtual_address
      dup VirtualSize @ to virtual_size
      drop
      optional{} ImportDirectoryRva @
      virtual_address dup virtual_size + WITHIN IF leave THEN
   LOOP
;

search_importsection  \ Virtualaddress (Offset)

\ ------------------------------------------------------------------------------
\ Import-Funktionen anzeigen.
\
\ Die IMPORT_DESCRIPTOREN bilden ein Array von Strukturen.
\ Die letzte ist eine Struktur mit lauter Nullen.

CREATE importsection{} raw_size chars allot   \ Array von IMPORT_DESCRIPTOREN

0  VALUE import0{}       \ 1. IMPORT_DESCRIPTOR
20 CONSTANT importsize   \ Länge

\ Weitere IMPORT_DESCRIPTOREN.
: import{} ( i -- adr ) importsize * import0{} + ;

\ Offset nach absolute Adresse transformieren.
: ofs>mem ( offset -- mem_adr )
   virtual_address - importsection{} +
;

\ Importsection laden und Zeiger setzen
: importsektion_laden ( -- )
   raw_pointer s>d fid REPOSITION-FILE drop
   importsection{} raw_size fid READ-FILE 2drop
   fid CLOSE-FILE drop
   optional{} ImportDirectoryRva @ ofs>mem to import0{}
;

\ Import-Funktinen anzeigen.
: .import ( -- )
   base @ hex
   10 0 DO
     cr
     i import{} DllName @ dup 0<>
     IF
       ( Name der dll-Datei anzeigen )
       cr ." IMPORTIERTE FUNKTIONEN AUS " ofs>mem >fstring type
       i import{} PointerToThunkData @
       BEGIN
         dup ofs>mem @ dup 0<>
       WHILE
         ( Nummer und Name der Funktionen anzeigen )
         dup ofs>mem w@ cr 4 .r space
         2 + ofs>mem >fstring type
         4 +
       REPEAT
       2drop
     ELSE
       drop leave
     THEN
   LOOP
   base !
   cr
;

importsektion_laden
.import

dumpmarker  \ alles 'vergessen'

\ ====================
\ DUMPWORD.4TH
\ Das Ausfuehrungswort
\ ====================

DECIMAL

CREATE path\name 64 chars allot  \ Dateiname

: includepath_pe   ( -- str len ) s" demos\winheader\pe.inc" ;
: includepath_dump ( -- str len ) s" demos\winheader\dumppeh.4th" ;

: DUMPPEH ( "pfad\name" -- )
   nostack                       \ nur fuer Win32for 
   bl word count path\name place
   includepath_dump INCLUDED
;

\ finis

\ ===============
\ PE.INC
\ Die Strukturen
\ ===============

DECIMAL

doshdr ((
\? cr .( HEADER VON ) path\name count type
structur IMAGE_DOS_HEADER
   2 field e_magic       \? .( 'MZ')
   2 field e_cblp        \? .( Laenge des letzten Sektors Modulo 512)
   2 field e_cp          \? .( Dateigroesse in 512 Byte-Seiten)
   2 field e_crlc        \? .( Laenge der Relocation-Tabelle)
   2 field e_cparhdr     \? .( Headergroesse in Paragraphen [je 16 Byte])
   2 field e_minalloc    \? .( Anzahl.min der Paragraphen)
   2 field e_maxalloc    \? .( Anzahl.max der Paragraphen)
   2 field e_ss          \? .( Stack-Segment-Offset)
   2 field e_sp          \? .( Inhalt des SP Registers beim Start)
   2 field e_csum        \? .( Checksumme in Zweierkomplement)
   2 field e_ip          \? .( Inhalt des IP Registers beim Start)
   2 field e_cs          \? .( Code-Segment-Offset ab Programmanfang)
   2 field e_lfarlc      \? .( Relocation-Tabelle-Offset)
   2 field e_ovno        \? .( Overlaynummer 0 fuer den residenten Teil)
   8 field res1          \? .( reserviert)
   2 field e_oemid       \? .( OEM-Bezeichner)
   2 field e_oeminfo     \? .( OEM-Info)
  20 field e_res2        \? .( reserviert)
   4 field e_lfanew      \? .( reserviert für Offset zum NTFILE_HEADER)
endstructur
doshdr ))

pehdr ((
\? cr .( HEADER VON ) path\name count type
structur NTFILE_HEADER
  4 field Signature               \? .( 'PE')
  2 field Machine                 \? .( 014Ch=i386)
  2 field NumberOfSections        \? .( Anzahl der Sektionen)
  4 field TimeDateStamp
  4 field PointerToSymbolTable    \? .( für debugging)
  4 field NumberOfSymbols         \? .( für debugging)
  2 field SizeOfOptionalHeader    \? .( Laenge vom OPTIONAL_HEADER)
  2 field Characteristic          \? .( Flags)
endstructur

structur OPTIONAL_HEADER
  2 field Magic                   \? .( 10b)
  1 field MajorLinkerVersion
  1 field MinorLinkerVersion
  4 field SizeOfCode              \? .( Code)
  4 field SizeOfInitializedData   \? .( initialisierte Daten
  4 field SizOfUninitializedData  \? .( nicht initialisierte Daten)
  4 field AddressOfEntryPoint     \? .( Start relativ zur Ladeadresse)
  4 field BaseOfCode              \? .( Codebasis relativ zur Ladeadresse)
  4 field BaseOfData              \? .( Datenbasis relativ zur Ladeadresse)
  4 field ImageBase               \? .( Ladeadresse)
  4 field SectionAlignment        \? .( Granularitaet im Speicher)
  4 field FileAlignment           \? .( Granularitaet in der Datei)
  2 field MajorOsVersion
  2 field MinorOsVersion
  2 field MajorImageVersion
  2 field MinorImageVersion
  2 field MajorSubsystemVersion
  2 field MinorSubsystemVersion
  4 field Win32VersionValue
  4 field SizeOfImage             \? .( Speicherverbrauch)
  4 field SizeOfHeaders
  4 field CheckSum
  2 field Subsystem               \? .( 2=Windows, 3=Console)
  2 field DllCharacteristics
  4 field SizeOfStackReserve
  4 field SizeOfStackCommit
  4 field SizeOfHeapReserve
  4 field SizeOfHeapCommit
  4 field LoaderFlags
  4 field NumberOfRvaAndSizes
  4 field ExportDirectoryRva      \? .( Offset zum EXPORT_DESCRIPTOR)
  4 field ExportSize
  4 field ImportDirectoryRva      \? .( Offset zum IMPORT_DESCRIPTOR)
  4 field ImportSize
112 field DataDirectory
endstructur
pehdr ))

sectionhdr ((
structur SECTION_HEADER
  8 field SectionName
  4 field VirtualSize             \? .( Anzahl der Bytes im Speicher)
  4 field VirtualAddress          \? .( Offset in Speicher)
  4 field SizeOfRawData           \? .( Laenge in der Datei)
  4 field PointerToRawData        \? .( Offset in der Datei)
  4 field PointerToRelocations
  4 field PointerToLinenumbers
  2 field NumberOfRelocations
  2 field NumberOfLinenumbers
  4 field Characteristics1        \? attribute
endstructur
sectionhdr ))

importhdr ((
structur IMPORT_DESCRIPTOR
   4 field PointerToThunkData     \ Adresse der Struktur THUNK_DATA
   4 field TimeDateStamp1
   4 field ForwarderChain
   4 field DllName                \ Name der dll-Datei
   4 field FirstThunk
endstructur

structur THUNK_DATA
   4 field ForwarderString        \ Name der Funktion: db fnummer,0,'Text',0
   4 field Function
   4 field Ordinal
   4 field AddressOfData
endstructur
importhdr ))