' Last updated: December 12, 2002
'
' Debug script generator by Benny Pedersen, http://2dos.homepage.dk
' Tested on Win98.
'
' ** Warning: This VBS file is a bit complex **
'
If WScript.Arguments.Count=0 Then
     CreateObject("WScript.Shell").Run"Start /Max " & "CScript.exe """ _
     & WScript.ScriptFullName & """ //NoLogo CScript."
     WScript.quit()
End If

Dim WshShell, fso, TMP, NF, NFSizeHex
Set WshShell=WScript.CreateObject("WScript.Shell")
Set fso=CreateObject("Scripting.FileSystemObject")
TMP= WshShell.ExpandEnvironmentStrings("%TMP%")

NF= fso.GetAbsolutePathName(InputBox _
                              ("Name of file:",, "\Windows\Rundll.exe"))

If NOT fso.FileExists(NF)Then MsgBox"Ok",, _
                                    "File does not exist.": WScript.quit
NFSizeHex= Hex(fso.GetFile(NF).size)

Function WAllColl_(Coll, MFBElement)
  Dim i, NOfR, AdrHex, AdrDec, WaTWr, Line0, Line1' AdrDec1
  Dim Th1E, ThLE, LenTh1E, LenThLE, CountRangeTh1E, CountRangeThLE
  Dim LenTh1Range, LenThLRange, More, CountSecRangeMFB, LngthSecRangeMFB
  Dim CountSecLastRangeMFB, LngthSecLastRangeMFB
  For i=0 to UBound(Coll)-1 Step 2
    NOfR= 0
    AdrHex= Coll(i)
    AdrDec= CInt("&h" & AdrHex)
    WaTWr= WrapStrngToMax_("E" & AdrHex & Coll(i+1), 79)
    Line0= Mid(WaTWr(0), Len(AdrHex)+2)
    Line1= WaTWr(1)
    If Line1=" " Then
         Line1= ""
    Else If LastElement_(Line0) = FirstElement_(Line1) Then
              Do While LastElement_(Line0) = FirstElement_(Line1)
                   Line1= FirstElement_(Line1) & Line1
                   Line0= SkipLastElement_(Line0)
              Loop
         Else If LastElement_(SkipLastElement_(Line0)) = MFBElement _
              AND NOT LastElement_ (Line0) = MFBElement _
              AND NOT FirstElement_(Line1) = MFBElement Then
                   Line1= LastElement_(Line0) & Line1
                   Line0= SkipLastElement_(Line0)
              End If
         End If
    End If
    'AdrDec1= AdrDec +NOfS_(Line0)
    Do While LastElement_(Line0) = MFBElement
         Line0= SkipLastElement_(Line0)
         NOfR= NOfR +1
    Loop
    Th1E= FirstElement_(Line0)
    ThLE= LastElement_ (Line0)
    LenTh1E= Len(Th1E)
    LenThLE= Len(ThLE)
    CountRangeTh1E= CountFirstRange_(Line0)
    CountRangeThLE= CountLastRange_ (Line0)
    LenTh1Range= CountRangeTh1E * LenTh1E
    LenThLRange= CountRangeThLE * LenThLE
    If Replace(Line0, Th1E, "") = "" AND LenTh1Range >5 Then
         Fill= Fill & "," & AdrHex & "," & CountRangeTh1E & "," & Th1E
    ElseIf LenTh1Range >10 Then
         Fill= Fill & "," & AdrHex & "," & CountRangeTh1E & "," & Th1E
         More= Mid(Line0, LenTh1Range +1)
         If NOfR = 0 Then
              Line1= More & Line1
              'AdrDec1= AdrDec1 -NOfS_(More)
              NOfR= -NOfS_(More)
         Else WAllColl_= WAllColl_ & Hex(AdrDec +CountRangeTh1E) & "," _
                        & More & ","
         End If
    ElseIf LenThLRange >10 Then
         Fill= Fill & "," & Hex(AdrDec +NOfS_(Line0) -CountRangeThLE) _
               & "," & CountRangeThLE & "," & ThLE
         More= Left(Line0, Len(Line0) -LenThLRange)
         If Line1="" Then
              Line1= More
              'AdrDec1= AdrDec
              NOfR= -NOfS_(Line0)
         Else WAllColl_= WAllColl_ & AdrHex & "," & More & ","
         End If
    ElseIf CountRangeTh1E >1 Then
         CountSecRangeMFB= CountSecRangeMFB_(Line0)
         LngthSecRangeMFB= CountSecRangeMFB * Len(MFBElement)
         If LngthSecRangeMFB +LenTh1Range > 10 Then
              Fill= Fill & "," & AdrHex & "," & CountRangeTh1E & "," _
                    & Th1E
              More= Mid(Line0, LenTh1Range +LngthSecRangeMFB +1)
              If Line1="" Then
                   Line1= More
                   'AdrDec1= AdrDec +CountRangeTh1E +CountSecRangeMFB
                   NOfR= -NOfS_(Line0) +CountRangeTh1E +CountSecRangeMFB
              Else WAllColl_= WAllColl_ & Hex(AdrDec +CountRangeTh1E _
                             +CountSecRangeMFB) & "," & More & ","
              End If
         Else WAllColl_= WAllColl_ & AdrHex & "," & Line0 & ","
         End If
    ElseIf CountRangeThLE >1 Then
             CountSecLastRangeMFB= CountSecRangeMFB_((" " _
                                & Left(StrReverse(Line0),Len(Line0)-1)))
             LngthSecLastRangeMFB= CountSecLastRangeMFB *Len(MFBElement)
             If LngthSecLastRangeMFB +LenThLRange > 10 Then
                  Fill= Fill & "," & Hex(AdrDec +NOfS_(Line0) _
                    -CountRangeThLE) & "," & CountRangeThLE & "," & ThLE
                  More= Left(Line0, Len(Line0) -LenThLRange _
                        -LngthSecLastRangeMFB)
                  If Line1="" Then
                       Line1= More
                       'AdrDec1= AdrDec
                       NOfR= -NOfS_(Line0)
                  Else WAllColl_= WAllColl_ & AdrHex & "," & More & ","
                  End If
             Else WAllColl_= WAllColl_ & AdrHex & "," & Line0 & ","
             End If
    Else WAllColl_= WAllColl_ & AdrHex & "," & Line0 & ","
    End If
    If NOT Line1 = "" Then
         Do While FirstElement_(Line1) = MFBElement
              Line1= SkipFirstElement_(Line1)
              'AdrDec1= AdrDec1 +1
              NOfR= NOfR +1
         Loop
       ' Coll(i)= Hex(AdrDec1)
         Coll(i)= Hex(CInt(AdrDec +NOfS_(Line0) +NOfR))
         Coll(i+1)= Line1
         i= i -2
    End If
  Next
End Function

WshShell.Run"%ComSpec% /cCopy """ & NF & """ ""%TMP%.\#1""", 0, -1
WshShell.Run"%ComSpec% /cEcho.Exit|%ComSpec% /kPrompt D100L" _
    & NFSizeHex & "$_Q|debug %TMP%.\#1>""%TMP%.\#2""", 0, -1

WScript.echo "[141]. Created dump file: """ & TMP & ".\#2"""
WScript.sleep(2500)

Dim RFile, RLine, LongLine
Set RFile= fso.openTextFile(TMP & ".\#2", 1)
Do: RLine= RFile.ReadLine
    If Mid(Rline,5,1)=":" Then
         WScript.echo "[148]. Data to LongLine : "_
                            & Mid(RLine,12,23) & " "& Mid(RLine,36,24):_
         LongLine= LongLine & Mid(RLine,12,23) & " "& Mid(RLine,36,24)
    End If
Loop Until LCase(Left(RLine,2))="-q": RFile.Close

WScript.sleep(1400)

Dim WFile: Set WFile= fso.openTextFile(TMP & ".\#1", 2, -1)
WFile.WriteLine"e0'** Copy of " & NF & " **'"
WFile.WriteLine"e0'** Named:  " & TMP & ".\#3 **'"
WFile.WriteLine"e0'** Usage:  cd temp AND debug<#1 **'"

Dim MFB, MFBHex, MFBElement, MFBLastOccurRelAdrDec
Dim Pos, PosStart, Relative, Absolute
MFB= Left(MostFreqByte_(LongLine), 2)
MFBHex= Hex(CInt("&h" & MFB))
MFBElement= " " & MFBHex
MFBLastOccurRelAdrDec= (InStrRev(LongLine, MFB, Len(LongLine)) +2)/3
Pos= 256
PosStart= 15
Relative= Hex(Pos -PosStart +MFBLastOccurRelAdrDec)
Absolute= Hex(Pos +MFBLastOccurRelAdrDec -1)

WFile.WriteLine"n" & TMP & ".\#3"
If Len(Relative) < Len(Absolute) Then
     WFile.WriteLine "F" & Hex(PosStart) & "L"& Relative & " "& MFBHex
Else WFile.WriteLine "F" & Hex(PosStart) & " "& Absolute & " "& MFBHex
End If

Dim Fill, Hx, AByte, Range, Co, NumbOfElement, AllCo, RangeStart
Fill= Hex(PosStart) & "," & Relative & "," & " " & MFBHex
Hx= Hex(Pos -1)

Do: Hx= Hex(("&h" & Hx) +1)
    AByte= Mid(LongLine, (("&h" & Hx) -Pos +1)*3 -2, 2)
    If Range=AByte Then
         Co= Co & " " & AByte
    Else If NOT Range="" Then
              NumbOfElement= CInt(Len(Co)/3): Co= Replace(Co," 0"," ")
              If CInt(Len(Co)) >15 Then
                   Fill= Fill & "," & RangeStart & "," _
                         & Hex(NumbOfElement) & "," & LastElement_(Co)
              Else ALLCo= ALLCo & RangeStart & "," & Co & ","
              End If
              WScript.echo"[193]. "& RangeStart & Co: WScript.Sleep(0)
         End If
         If AByte = MFB Then
              Range= ""
         Else Range= AByte: RangeStart= Hx: Co= " " & AByte
         End If
    End If
Loop Until CInt("&h" & Hx) >CInt(("&h" & NFSizeHex) +Pos -1)

Dim Lngth: WScript.echo vbCrLf & String(80,"'")
Do: Lngth= Len(ALLCo)
    'WshShell.Popup Lngth, 1, "LineNumb [204]", 64
    'Ct= Ct_(Ct, 205, "", Lngth)
    WScript.echo"[206]. " & Lngth
    Co= Split(ALLCo, ",", -1, 1)
    ALLCo= ALLColl_(Co, MFBHex)
Loop Until Lngth=Len(ALLCo)

WScript.sleep(1400)

Do: Lngth= Len(ALLCo)
    ALLCo= WAllColl_(Co, MFBElement)
    Co= Split(ALLCo, ",", -1, 1)
    WScript.echo ALLCo
Loop Until Lngth=Len(ALLCo)

Dim i: WScript.sleep(1800)
For i=0 to UBound(Co)-1 Step 2
     WFile.WriteLine "E" & Co(i) & Co(i+1)
     WScript.echo    "E" & Co(i) & Co(i+1)
Next

WScript.echo String(80,"_")
WScript.sleep(999)

Co= Split(Fill, ",", -1, 1)
i= 3
For i=3 to UBound(Co) -2 Step 3
     WFile.WriteLine "F" & Co(i) & "L" & Co(i+1) & Co(i+2)
     WScript.echo    "F" & Co(i) & "L" & Co(i+1) & Co(i+2)
Next

WFile.WriteLine "rCX" & vbCrLf & NFSizeHex & vbCrLf _
                & "w" & vbCrLf & "q"
WFile.Close

WshShell.Run"%ComSpec% /cDebug<""%TMP%""" & ".\#1", 1, -1

WshShell.Run"%ComSpec% /cFC /b """ & TMP & """.\#1 """ & TMP _
    & """.\#1" & "|Find ""FC: "">""" & TMP & """.\#2", 0, -1
WshShell.Run"%ComSpec% /cFC /b """ & TMP & """.\#3 " & NF _
             & "|Find ""FC: "">>"""& TMP & """.\#2", 0, True

Set RFile= fso.openTextFile(TMP & ".\#2", 1)
RLine= RFile.ReadLine
If RLine = RFile.ReadLine Then
     MsgBox "To create a copy of: " & vbCrLf & NF & vbCrLf _
             & "named: """ & TMP & "\#3"", use this file: "_
             & vbCrLf & TMP & "\#1",, "Size of #1 is " _
             & fso.GetFile(TMP & ".\#1").size & " bytes"
Else MsgBox "Error"
End If: RFile.Close

WshShell.Run "%ComSpec% /cErase """ & TMP & """.\#3", 0
WshShell.Run "%ComSpec% /cErase """ & TMP & """.\#2", 0
WshShell.Run "%ComSpec% /cDel /p """& TMP & """.\#1", 1, -1

Set fso= Nothing: Set WshShell= fso: Set RFile= fso: Set WFile= fso
WScript.quit
'__
' Most Frequent Byte of 
' Space Delimitted Two Digits Hex, (SD2DH).
' SD2DH can be prefixed or/and appended with any number of space char.
' Since any numb includes zero, then SD2DH could look like this:
' "AB  CD", or "   AB CD  ", or "AB CD ", or...
'
Function MostFreqByte_(ByVal SD2DH)
  MostFreqByte_= String(15, "0")
  SD2DH= " " & UCase(SD2DH)
  Dim Hx, Freq
  Hx= "00"
  Do: Freq= CInt((Len(SD2DH) -Len(Replace(SD2DH, " " & Hx, "")))/3)
      If Freq >= CInt(Mid(MostFreqByte_, 15)) Then _
        MostFreqByte_= Hx & ". Frequency: " & Freq
      Hx= Hex(("&h" & Hx) +1)
      If CInt("&h" & Hx) < 16 Then Hx= "0" & Hx
  Loop Until Hx = "100"
End Function
'__
' Wrapping to max:
' For ex: MsgBox WrapStrngToMax_(" A B C", 4)(0)' Returns " A B"
' For ex: MsgBox WrapStrngToMax_(" A B C", 4)(1)' Returns " C"
'
Function WrapStrngToMax_(Strng, ToMax)
   Dim Pos : Pos= Len(Strng)
   If ToMax>=Pos Then Strng= Strng & " " & String(ToMax -Pos, ",")
   Pos= InStrRev(Strng, " ", ToMax +1)
   WrapStrngToMax_= Left(Strng, Pos -1) & "," & Mid(Strng, Pos)
   WrapStrngToMax_= Split(WrapStrngToMax_, ",", -1, 1)
End Function
'__
' Number of Space, ASCII value 32, ( to get the number of elements),
'
Function NOfS_(Strng)
  NOfS_= CInt(Len(Strng) -Len(Replace(Strng, " ", "")))
End Function
'__
Function FirstElement_(Strng)
  FirstElement_= Left(Strng, InStr(2, Strng & " ", " ") -1)
End Function
'__
Function LastElement_(Strng)
  LastElement_= " " & Mid(Strng, InStrRev(Strng, " ", Len(Strng) -1) +1)
End Function
'__
Function sMid_(Strng, NTh, Lngth)
' Works like Mid but with words instead of characters,
  Dim A, U, i
' The next line is modified for strings without a leading space,
  A= Split(Replace(" " & Strng, "  ", " "), " ", -1, 1)
  i= NOfS_(Strng)
  U= NTh +Lngth -1: U= (U>i)*(U -i) +U
  For i=NTh to U
     sMid_= sMid_ & " " & A(i)
  Next
End Function
'__
Function SkipLastElement_(Strng)
  SkipLastElement_= Left(Strng, InStrRev(Strng, " ", Len(Strng) -1) -1)
End Function
'__
Function SkipFirstElement_(Strng)
  SkipFirstElement_= Mid(Strng, InStr(2, Strng & " ", " "))
End Function
'__
Function Ct_(Ct,L,Comment,V)
  If Ct=L Then Ct_= L: Exit Function
  Ct="(id: "& L & "). Press hyphen to continue without this MSG"
  Ct=InputBox("Type: "& VarType_(V) & vbCrLf & "Len: "& Len(V) _
                      & vbCrLf & vbCrLf & Comment, Ct, V,, 0)
  If VarType(Ct)=0 Then If MsgBox("Quit VBS",36,Ct)-7 Then WScript.quit
  If Ct="-" Then Ct_= L
End Function'
Function VarType_(V)
 Select Case VarType(V)
  Case  0 VarType_="Empty (uninitialized)"' vbEmpty
  Case  1 VarType_="Null (no valid data)"' vbNull
  Case  2 VarType_="Integer"' vbInteger
  Case  3 VarType_="Long integer"' vbLong
  Case  4 VarType_="Single-precision floating-point number"' vbSingle
  Case  5 VarType_="Double-precision floating-point number"' vbDouble
  Case  6 VarType_="Currency"' vbCurrency
  Case  7 VarType_="Date"' vbDate 
  Case  8 VarType_="String"' vbString
  Case  9 VarType_="Automation object"' vbObject
  Case 10 VarType_="Error"' vbError
  Case 11 VarType_="Boolean"' vbBoolean
  Case 12 VarType_="Variant (arrays of Variants)"' vbVariant
  Case 13 VarType_="A data-access object"' vbDataObject
  Case   17 VarType_="Byte"' vbByte
  Case 8192 VarType_="Array"' vbArray
 End Select
End Function
'__
' AllCollections
'
Function ALLColl_(Coll, MFBHex)
  Dim Gap,i,j
  For i=0 to UBound(Coll)-1 Step 4
     ALLColl_= ALLColl_ & Coll(i) & "," & Coll(i+1)
     If Coll(i+2)="" Then ALLColl_= ALLColl_ & ",": Exit For
     Gap= CInt(("&h" & Coll(i+2)) -NOfS_(Coll(i+1)) -("&h" & Coll(i)))
     If Gap =3 AND CInt("&h" & MFBHex) >15 Then Gap= 4
     If Gap <4 Then
          For j=1 to Gap
          ALLColl_= ALLColl_ & " " & MFBHex
          Next
          ALLColl_= ALLColl_ & Coll(i+3) & ","
     Else ALLColl_= ALLColl_ & "," & Coll(i+2) & "," & Coll(i+3) & ","
     End If
  Next
End Function
'__
Function CountFirstRange_(Strng)
  Dim Th1E, LenTh1E, LenStrng
  Th1E= FirstElement_(Strng)
  LenTh1E= CInt(Len(Th1E))
  LenStrng= CInt(Len(Strng))
  For i= 2 +LenTh1E to LenStrng Step LenTh1E
    If NOT Mid(Strng & " ", i, LenTh1E) = Mid(th1E & " ", 2, LenTh1E)_
    Then Exit For
  Next
  CountFirstRange_= CInt((i -2) / LenTh1E)
End Function
'__
Function CountLastRange_(Strng)
  Dim ThLE, LenThLE, i, Count
  ThLE= LastElement_(Strng)
  LenThLE= CInt(Len(ThLE))
  i= CInt(Len(Strng) +1 -LenThLE)
  Count= 0
  Do While i > 0
     If NOT Mid(Strng, i, LenThLE) = ThLE Then Exit Do
     Count= Count +1
     i= i -LenThLE
  Loop
  CountLastRange_= Count
End Function
'__
Function CountSecRangeMFB_(Strng)
  CountSecRangeMFB_= 0
  Dim A, U, i, SecRange
  A= Split(Strng, " ", -1, 1)
  U= UBound(A)
  For i=2 To U
     If NOT A(i)=A(1) Then
          If NOT A(i) = MFBHex Then Exit Function
          A(1)= A(i)
          Exit For
     End If
  Next
  For i=i To U : If NOT A(i) = A(1) Then Exit For
     CountSecRangeMFB_= CountSecRangeMFB_ +1
  Next
End Function
'__