Malicious Office (OLE) / .DOC — malware analysis report

Static analysis result for SHA-256 65e07690e1e6450f…

MALICIOUS

Office (OLE) / .DOC

223.5 KB Created: 1994-10-18 16:34:00 Authoring application: Microsoft Word 9.0 First seen: 2026-05-10
MD5: 76b54b0a3449be5d54bed443fddf4c61 SHA-1: 9e58068ec8c5b4a8f1a56d32193de0b0dab467df SHA-256: 65e07690e1e6450f8996c485a603d137ae53835d69de5f60b7641682d2a5629c
100 Risk Score

Malware Insights

MITRE ATT&CK
T1059.005 Visual Basic

The critical heuristic firing for VBA macro-virus self-replication and AV tampering, along with the detection of legacy WordBasic auto-exec markers, strongly suggests malicious intent. The VBA script itself contains comments and code related to managing referents and adapting to different Word versions, but its primary malicious function appears to be self-replication within the VBA project. No external network activity or specific payload delivery was directly observed in the provided evidence.

Heuristics 3

  • VBA macros detected medium 1 related finding OLE_VBA_MACROS
    Document contains VBA macro code
  • VBA macro-virus self-replication / AV tampering critical OLE_VBA_MACRO_VIRUS_REPLICATION
    VBA macro programmatically rewrites VBA project code through the VBE object model (CodeModule/VBComponents InsertLines/DeleteLines/AddFromString or OrganizerCopy) to copy itself into the global template and other open documents, and/or disables Office macro-virus protection (Options.VirusProtection = False). This is the defining behavior of the W97M document macro-virus family — self-replicating code with no benign document use, independent of any AV signature.
    Matched line in script
            Application.OrganizerCopy _
  • Legacy WordBasic auto-exec macro marker medium OLE_LEGACY_WORDBASIC_AUTOEXEC
    OLE Word document contains a legacy WordBasic auto-execution marker such as AutoOpen, but no modern VBA project was recovered and no stronger macro-virus family marker was present. This is analyst-facing evidence for old Word macro execution surface, not a downloader or parser-CVE attribution by itself.

Extracted artifacts 1

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source) 50696 bytes
SHA-256: c154ed01a48723911ed61acf0c98fae7237cb9360441965728986ba539dd37a8
Preview script
First 1,000 lines of the extracted script
Attribute VB_Name = "ThisDocument"
Attribute VB_Base = "0{00020906-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "ReferentenVerwaltung"

Rem Sachbearbeiter-Verwaltung für Schreibstuben etc./REI/15.03.1995
Rem Version 2.0/28.04.97 für WORD6
Rem     REFERENT.DAT als Word-Dokument, befindet sich entweder lokal auf \DATABASE oder im Netz auf \VORLAGE6\DATABASE
Rem 12.09.97: Nicht Betriebssystem-, sondern Word-Version wird unterschieden, damit auch für Word6 unter Win95 geeignet
'11.01.2001: Anpassung für Office2000

'Dim Shared Namen$(0), Durchwahl$(0), BZ$(0), ZeigZeile$(0), Fehlerwert, Datei$, zaehler, MaxReferenten, geaendert, lz$, CrLf$, Tab$
Dim sName2$, sZeichenSB$, sDurchwahl$

Public Sub main()
Attribute main.VB_Description = "Prüft Übertrag"
Attribute main.VB_ProcData.VB_Invoke_Func = "Normal.ReferentenVerwaltung.MAIN"
Dim Fehlerwert
Dim CrLf$
Dim Tab_$
Dim xName$
Dim xBz$
Dim xDurchwahl$
sName2$ = ""
sZeichenSB$ = ""
sDurchwahl$ = ""
Fehlerwert = 0
CrLf$ = Chr(13) + Chr(10)
Tab_$ = Chr(9)
xName$ = sName2$
xBz$ = sZeichenSB$
xDurchwahl$ = sDurchwahl$
RefVerw xName$, xBz$, xDurchwahl$
End Sub



'----------------------------RefVerw
Private Sub RefVerw(xName$, xBz$, xDurchwahl$)
Dim bearbeitet
Dim VWord$
Dim netz$
Dim LW$
Dim Datei$
Dim geladen
Dim n
Dim fNummer
Dim MaxReferenten
WordBasic.ScreenUpdating 0
bearbeitet = 0
'VWord$ = WordBasic.[AppInfo$](2)
'If InStr(VWord$, "6.0") <> 0 Then
'    netz$ = WordBasic.[GetPrivateProfileString$]("Info", "Netz", "WINWORD6.INI")
'    LW$ = WordBasic.[GetPrivateProfileString$]("Info", "GRPLW", "WINWORD6.INI")
'Else
'    netz$ = WordBasic.[GetPrivateProfileString$]("HKEY_CURRENT_USER\Software\Microsoft\Word\7.0\Options", "Netz", "")
'    LW$ = WordBasic.[GetPrivateProfileString$]("HKEY_CURRENT_USER\Software\Microsoft\Word\7.0\Options", "GRPLW", "")
'End If
netz$ = System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\9.0\Common\General", "NETZ")
If netz$ = "JA" Then
    Datei$ = Options.DefaultFilePath(wdWorkgroupTemplatesPath) + "\DATABASE\REFERENT.DAT"
Else
    Datei$ = "C:\DATABASE\REFERENT.DAT"
End If
geladen = 0
For n = 1 To WordBasic.CountWindows()
    If WordBasic.[FileNameFromWindow$](n) = Datei$ Then
        geladen = n
        fNummer = n
        WordBasic.WindowList fNummer
    End If
Next n
If geladen = 0 Then
    Documents.Open FileName:=Datei$ ', Visible:=False
    'WordBasic.FileOpen Datei$
    fNummer = WordBasic.Window()
End If
Documents(Datei$).Activate
Again:
'If WordBasic.DocMaximize() = -1 Then WordBasic.DocMaximize
'WordBasic.DocMove 1000, 1000
Rem FensterAlleAnordnen
Rem fName$ = FensterName$(fNummer)
WordBasic.StartOfDocument
If WordBasic.SelInfo(12) <> -1 Then
    WordBasic.WW6_EditClear
End If
'ZeileUnten
MaxReferenten = WordBasic.SelInfo(15) - 1       'Anzahl der Zeilen der Tabelle
RefWahl MaxReferenten, xName$, xBz$, xDurchwahl$, bearbeitet
If bearbeitet = 0 Then
    WordBasic.WindowList fNummer
    WordBasic.FileClose 1
Else
    bearbeitet = 0
    WordBasic.WindowList fNummer
    WordBasic.StartOfDocument
    If WordBasic.SelInfo(12) = -1 And WordBasic.SelInfo(15) > 2 Then        'Markierung ist in einer Tabelle und es sind mindestens zwei Einträge enthalten
        WordBasic.TableSort DontSortHdr:=1
    End If
    GoTo Again
End If
sName2$ = xName$
sZeichenSB$ = xBz$
sDurchwahl$ = xDurchwahl$
End Sub


'------------------------------------RefWahl
'Referenten aus Liste wählen oder bearbeiten
Private Sub RefWahl(MaxReferenten, xName$, xBz$, xDurchwahl$, bearbeitet)
Dim lz$
Dim dummy
Dim Zelle
Dim n
Dim zahl
Dim Fehlerwert
ReDim AdrArr__$(MaxReferenten, 3)
lz$ = Chr(13) + Chr(7)
WordBasic.TableSelectRow
WordBasic.ParaDown
ReDim ANamen__$(MaxReferenten)
For dummy = 1 To MaxReferenten
    WordBasic.TableSelectRow
    'ZeichRechts
    WordBasic.PrevCell
    For Zelle = 0 To 2
        If WordBasic.[Selection$]() <> lz$ Then
            AdrArr__$(dummy, Zelle) = WordBasic.[Selection$]()
        Else
            AdrArr__$(dummy, Zelle) = ""
        End If
        If Zelle < 2 Then
            WordBasic.NextCell
        End If
    Next Zelle
'   AdrArr$(dummy, Zelle) = Markierung$()
    If dummy < MaxReferenten Then
        WordBasic.NextCell
    End If
    ANamen__$(dummy - 1) = AdrArr__$(dummy, 0) + " " + AdrArr__$(dummy, 1)
Next dummy
Again:
WordBasic.BeginDialog 464, 136, "Wählen Sie einen Referenten"
    WordBasic.Text 16, 11, 169, 12, "&Vorhandene Referenten:"
    WordBasic.ListBox 16, 27, 296, 97, ANamen__$(), "ANamen"
    WordBasic.PushButton 327, 6, 109, 21, "&Übernehmen", "Definierbar1"
    WordBasic.PushButton 327, 30, 109, 21, "&Bearbeiten", "Definierbar2"
    WordBasic.PushButton 327, 54, 109, 21, "&Hinzufügen", "Definierbar3"
    WordBasic.PushButton 327, 78, 109, 21, "Löschen", "Definierbar4"
    WordBasic.CancelButton 327, 102, 109, 21
WordBasic.EndDialog
Dim dlg As Object: Set dlg = WordBasic.CurValues.UserDialog
n = WordBasic.Dialog.UserDialog(dlg)
Rem For dummy = 1 To MaxReferenten
Rem Print dummy
Rem Print AdrArr$(dummy, 0)
Rem Next dummy
zahl = dlg.Anamen + 1
Select Case n
    Case 1  'Übernehmen
        xName$ = AdrArr__$(zahl, 0)
        xDurchwahl$ = AdrArr__$(zahl, 1)
        xBz$ = AdrArr__$(zahl, 2)
    Case 2  'Bearbeiten
        xName$ = AdrArr__$(zahl, 0)
        xDurchwahl$ = AdrArr__$(zahl, 1)
        xBz$ = AdrArr__$(zahl, 2)
        RefBearbeiten xName$, xDurchwahl$, xBz$, bearbeitet
    Case 3  'Hinzufügen
        RefHinzu bearbeitet
    Case 4  'Löschen
        xName$ = AdrArr__$(zahl, 0)
        xDurchwahl$ = AdrArr__$(zahl, 1)
        xBz$ = AdrArr__$(zahl, 2)
        RefLöschen xName$, xDurchwahl$, xBz$, bearbeitet
    Case 0  'Abbrechen
        Fehlerwert = 1
        Beenden
End Select

If Fehlerwert = 1 Then GoTo Ende
Ende:
'ChDir CurrDir$
End Sub



'---------------------------- RefBearbeiten
Private Sub RefBearbeiten(xName$, xDurchwahl$, xBz$, bearbeitet)
Dim Titel$
Dim n
On Error GoTo -1: On Error GoTo Auffang
Titel$ = "Referenten bearbeiten"
'DokumentVerschieben 0, 0
WordBasic.StartOfDocument
WordBasic.EditFind Find:=xName$, Direction:=0, WholeWord:=1
WordBasic.BeginDialog 218, 124, Titel$
    WordBasic.Text 10, 7, 42, 13, "Name", "Text1"
    WordBasic.TextBox 8, 22, 190, 18, "Name"
    WordBasic.Text 10, 44, 72, 13, "Durchwahl", "Text2"
    WordBasic.TextBox 8, 58, 73, 18, "DW"
    WordBasic.Text 113, 46, 86, 13, "Briefzeichen", "Text3"
    WordBasic.TextBox 113, 59, 86, 18, "BZ"
    WordBasic.OKButton 7, 86, 88, 21
    WordBasic.CancelButton 113, 86, 88, 21
WordBasic.EndDialog
Dim dlg As Object: Set dlg = WordBasic.CurValues.UserDialog
dlg.Name = xName$
dlg.DW = xDurchwahl$
dlg.BZ = xBz$
n = WordBasic.Dialog.UserDialog(dlg)
If n = 0 Then GoTo Ende
xName$ = dlg.Name
xDurchwahl$ = dlg.DW
xBz$ = dlg.BZ
WordBasic.TableSelectRow
WordBasic.PrevCell
WordBasic.Insert xName$
WordBasic.NextCell
WordBasic.Insert xDurchwahl$
WordBasic.NextCell
WordBasic.Insert xBz$
bearbeitet = 1
Auffang:
If Err.Number > 0 Then Error Err.Number
Ende:
End Sub



'---------------------------- RefHinzu
Private Sub RefHinzu(bearbeitet)
Dim Titel$
Dim n
Dim xName$
Dim xDurchwahl$
Dim xBz$
'DokumentVerschieben 0, 0
Titel$ = "Referenten hinzufügen"
WordBasic.BeginDialog 218, 124, Titel$
    WordBasic.Text 10, 7, 42, 13, "Name", "Text1"
    WordBasic.TextBox 8, 22, 190, 18, "Name"
    WordBasic.Text 10, 44, 72, 13, "Durchwahl", "Text2"
    WordBasic.TextBox 8, 58, 73, 18, "DW"
    WordBasic.Text 113, 46, 86, 13, "Briefzeichen", "Text3"
    WordBasic.TextBox 113, 59, 86, 18, "BZ"
    WordBasic.OKButton 7, 86, 88, 21
    WordBasic.CancelButton 113, 86, 88, 21
WordBasic.EndDialog
Dim dlg As Object: Set dlg = WordBasic.CurValues.UserDialog
n = WordBasic.Dialog.UserDialog(dlg)
If n = 0 Then GoTo Ende
xName$ = dlg.Name
xDurchwahl$ = dlg.DW
xBz$ = dlg.BZ
WordBasic.EndOfDocument
WordBasic.TableInsertRow
WordBasic.PrevCell
WordBasic.Insert xName$
WordBasic.NextCell
WordBasic.Insert xDurchwahl$
WordBasic.NextCell
WordBasic.Insert xBz$
bearbeitet = 1
Ende:
End Sub



'---------------------------- RefLöschen
Private Sub RefLöschen(xName$, xDurchwahl$, xBz$, bearbeitet)
Dim Text_$
WordBasic.StartOfDocument
WordBasic.EditFind Find:=xName$, Direction:=0, WholeWord:=1
Text_$ = "Wollen Sie den Eintrag " + xName$ + " wirklich löschen?"
If WordBasic.MsgBox(Text_$, "Referenten löschen", 16 + 1) = -1 Then
    WordBasic.TableDeleteRow
    bearbeitet = 1
End If


End Sub



'-------------------------Beenden----------------

Private Sub Beenden()
Dim Fehlerwert
Fehlerwert = 1
WordBasic.MsgBox "Referenten-Verwaltung abgebrochen", " Referenten-Verwaltung", 48
End Sub

Attribute VB_Name = "AdressenVerwaltung"

Rem AdressenVerwaltung für CDBrief, CDFax, CDKurzBrief
Rem Erstellt am: 15.01.1997/REI
Rem 23.05.97: bei Einzelplatz keine Neu-Eingabe Adressen möglich - behoben
Rem 12.09.97: Nicht Betriebssystem-, sondern Word-Version wird unterschieden, damit auch für Word6 unter Win95 geeignet
'11.01.2001: Anpassung für Office2000

Dim eAnredeKurz$, eVorname$, eNachname$, eTitel$, eFirma$, eAbteilung$, ePosition$, eAdresse$, eOrt$, ePLZ$, eFax$, eAnredeLang$, EZUSTELL$
Dim sName1$, sName2$, sZeichenSB$, sZeichenST$, sAbteilung$, sDurchwahl$, sFaxDW$
Dim lz$, CrLf$, Tab_$, Fehlerwert, AdrArr__$(), AdrAnz, AdrPfadp$, AdrPfadg$, AdrDatei$, netz$, BriefFenster$, DatenFenster$, neu, Caption$

Public Sub main(xAnredeKurz$, xVorname$, xNachname$, xTitel$, xFirma$, xeAbteilung$, xPosition$, xAdresse$, xOrt$, xPLZ$, xFax$, xAnredeLang$, xName1$, xName2$, xZeichenSB$, xZeichenST$, xAbteilung$, xDurchwahl$, xFaxDW$, xFehler)
ReDim AdrArr__$(1, 1)
'Dim LW$
Dim Lf$
Dim Cr$
Dim xZustell$
Dim xTelefon$
eAnredeKurz$ = ""
eVorname$ = ""
eNachname$ = ""
eTitel$ = ""
eFirma$ = ""
eAbteilung$ = ""
ePosition$ = ""
eAdresse$ = ""
eOrt$ = ""
ePLZ$ = ""
eFax$ = ""
eAnredeLang$ = ""
EZUSTELL$ = ""
sName1$ = ""
sName2$ = ""
sZeichenSB$ = ""
sZeichenST$ = ""
sAbteilung$ = ""
sDurchwahl$ = ""
sFaxDW$ = ""
lz$ = ""
CrLf$ = ""
Tab_$ = ""
Fehlerwert = 0
AdrAnz = 0
AdrPfadp$ = ""
AdrPfadg$ = ""
AdrDatei$ = ""
netz$ = ""
BriefFenster$ = ""
DatenFenster$ = ""
neu = 0
Caption$ = ""
WordBasic.ScreenUpdating 0
Fehlerwert = 0
neu = 0
sName1$ = xName1$
sName2$ = xName2$
sZeichenSB$ = xZeichenSB$
sZeichenST$ = xZeichenST$
sAbteilung$ = xAbteilung$
sDurchwahl$ = xDurchwahl$
sFaxDW$ = xFaxDW$
BriefFenster$ = WordBasic.[WindowName$]()
AdrDatei$ = "W6ADRESS.DOC"
'netz$ = WordBasic.[GetPrivateProfileString$]("HKEY_CURRENT_USER\Software\Microsoft\Word\7.0\Options", "Netz", "")
netz$ = System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\9.0\Common\General", "NETZ")
'LW$ = WordBasic.[GetPrivateProfileString$]("HKEY_CURRENT_USER\Software\Microsoft\Word\7.0\Options", "GRPLW", "")
If netz$ = "JA" Then
    AdrPfadp$ = "C:\DATABASE\"  'Pfad persönliche Adreßdatei
    'AdrPfadg$ = LW$ + "\DATABASE\"  'Pfad gemeinsame Adreßdatei
    AdrPfadg$ = Options.DefaultFilePath(wdWorkgroupTemplatesPath) + "\DATABASE\"  'Pfad gemeinsame Adreßdatei
Else
    AdrPfadp$ = "C:\DATABASE\"  'Pfad persönliche Adreßdatei
    AdrPfadg$ = AdrPfadp$       'nur persönliche Adreßdatei vorhanden
End If
Lf$ = Chr(13)
CrLf$ = Chr(13) + Chr(10)
Cr$ = Chr(13)
Tab_$ = Chr(9)
EmpfängerQuelle
xZustell$ = EZUSTELL$
xAnredeKurz$ = eAnredeKurz$
xVorname$ = eVorname$
xNachname$ = eNachname$
xTitel$ = eTitel$
xFirma$ = eFirma$
xeAbteilung$ = eAbteilung$
xPosition$ = ePosition$
xAdresse$ = eAdresse$
xOrt$ = eOrt$
xPLZ$ = ePLZ$
xTelefon$ = eTelefon$
xFax$ = eFax$
xAnredeLang$ = eAnredeLang$
xName1$ = sName1$
xName2$ = sName2$
xZeichenSB$ = sZeichenSB$
xZeichenST$ = sZeichenST$
xAbteilung$ = sAbteilung$
xDurchwahl$ = sDurchwahl$
xFaxDW$ = sFaxDW$
xFehler = Fehlerwert
If DatenFenster$ <> "" Then
    WordBasic.Activate DatenFenster$
    WordBasic.DocClose 1
End If
End Sub



'----------------------------------EmpfängerQuelle
Private Sub EmpfängerQuelle()
Dim Choice
Again:
WordBasic.BeginDialog 506, 113, "Adresse des Empfängers"
    WordBasic.GroupBox 20, 7, 467, 66, "Einfügen aus"
    WordBasic.PushButton 34, 31, 149, 23, "&pers. Adreßbuch"
    If netz$ = "JA" Then
        WordBasic.PushButton 198, 31, 139, 23, "&gem. Adreßbuch"
    End If
    WordBasic.PushButton 344, 31, 125, 23, "Ne&u..."
    WordBasic.CancelButton 206, 81, 125, 23
WordBasic.EndDialog
Dim dlg As Object: Set dlg = WordBasic.CurValues.UserDialog
Err.Number = 0
Choice = WordBasic.Dialog.UserDialog(dlg, 1)
If netz$ = "JA" Then        'Hinzugefügt 23.05.97
    Select Case Choice
        Case 0      'abgebrochen
        If Beenden = 1 Then
            GoTo Ende
        Else
            GoTo Again
        End If
        Case 1      'pers. Adreßbuch
            Caption$ = "persönliches Adreßbuch"
            AdrDatei$ = AdrPfadp$ + AdrDatei$
            AdresseLesen (AdrDatei$)
            AdresseBereit
        Case 2      'gem. Adreßbuch
            Caption$ = "gemeinsames Adreßbuch"
            AdrDatei$ = AdrPfadg$ + AdrDatei$
            AdresseLesen (AdrDatei$)
            AdresseBereit
        Case 3      'Neu
            Caption$ = "Neu"
            neu = 1
            ReDim AdrArr__$(1, 12)
            AdresseBestätigen (1)
        Case Else
            WordBasic.Beep
    End Select
Else
    Select Case Choice
        Case 0      'abgebrochen
            If Beenden = 1 Then
                GoTo Ende
            Else
                GoTo Again
            End If
        Case 1      'pers. Adreßbuch
            Caption$ = "persönliches Adreßbuch"
            AdrDatei$ = AdrPfadp$ + AdrDatei$
            AdresseLesen (AdrDatei$)
            AdresseBereit
        Case 2      'Neu
            Caption$ = "Neu"
            neu = 1
            ReDim AdrArr__$(1, 12)
            AdresseBestätigen (1)
        Case Else
            WordBasic.Beep
    End Select
End If
Ende:
End Sub



'------------------------------------Adresse bestätigen---------
Private Sub AdresseBestätigen(wahl)
Dim netz_
Dim Choice
WordBasic.BeginDialog 482, 394, "Empfänger aus: "
    WordBasic.Text 6, 14, 87, 13, "Anrede kurz:", "Text4"
    WordBasic.TextBox 103, 8, 160, 18, "eAnredekurz"
    WordBasic.Text 52, 29, 36, 15, "&Titel:"
    WordBasic.TextBox 103, 29, 106, 18, "Title"
    WordBasic.Text 222, 28, 61, 13, "&Position:"
    WordBasic.TextBox 296, 28, 172, 18, "ePosition"
    WordBasic.Text 22, 51, 67, 13, "&Vorname:"
    WordBasic.TextBox 104, 50, 364, 18, "Vorname"
    WordBasic.Text 10, 71, 79, 12, "Na&chname:"
    WordBasic.TextBox 103, 71, 365, 18, "Nachname"
    WordBasic.Text 46, 91, 44, 12, "&Firma:"
    WordBasic.TextBox 103, 91, 132, 18, "eFirma"
    WordBasic.Text 248, 92, 32, 16, "A&bt.:"
    WordBasic.TextBox 299, 92, 167, 18, "eAbteilung"
    WordBasic.Text 39, 112, 51, 13, "&Straße:"
    WordBasic.TextBox 102, 112, 366, 18, "eAdresse"
    WordBasic.Text 53, 137, 32, 12, "PL&Z:"
    WordBasic.TextBox 101, 135, 102, 18, "ePLZ"
    WordBasic.Text 210, 135, 25, 13, "&Ort:"
    WordBasic.TextBox 245, 135, 222, 18, "eOrt"
    WordBasic.Text 34, 160, 55, 13, "Fa&x-Nr.:"
    WordBasic.TextBox 101, 157, 192, 18, "eFax"
    WordBasic.Text 5, 185, 92, 13, "Brief-Anrede:", "AnredeLang"
    WordBasic.TextBox 101, 180, 366, 18, "eAnredeLang"
    WordBasic.GroupBox 9, 204, 463, 104, "Absender:"
    WordBasic.Text 22, 221, 102, 14, "Verantwortlich:"
    WordBasic.TextBox 144, 217, 251, 18, "Name1"
    WordBasic.TextBox 402, 217, 60, 18, "BZ1"
    WordBasic.Text 22, 243, 112, 13, "Sachbearbeiter:"
    WordBasic.TextBox 145, 240, 248, 18, "Name2"
    WordBasic.TextBox 402, 240, 60, 18, "BZ2"
    WordBasic.Text 15, 264, 70, 13, "Abteilung:"
    WordBasic.TextBox 101, 261, 160, 18, "xAbt"
    WordBasic.Text 279, 263, 88, 13, "Telefon-DW:"
    WordBasic.TextBox 280, 284, 113, 18, "DW"
    WordBasic.Text 51, 288, 30, 13, "Fax:"
    WordBasic.TextBox 102, 284, 132, 18, "xFax"
    WordBasic.GroupBox 8, 314, 466, 71, " Adresse plazieren: "
If netz$ = "JA" Then
    WordBasic.PushButton 28, 330, 148, 22, "&Nur im Schriftstück"
    WordBasic.PushButton 200, 330, 261, 22, "&Im Schriftstück und pers. Adreßbuch"
    WordBasic.PushButton 200, 355, 261, 22, "Im &Schriftstück und gem. Adreßbuch"
Else
    WordBasic.PushButton 30, 330, 148, 22, "&Nur im Brief"
    WordBasic.PushButton 199, 330, 261, 22, "&Im Schriftstück und pers. Adreßbuch"
End If
    WordBasic.CancelButton 28, 355, 151, 22
WordBasic.EndDialog
Dim dlg As Object: Set dlg = WordBasic.CurValues.UserDialog
dlg.eAnredeKurz = (AdrArr__$(wahl, 0))
dlg.Vorname = (AdrArr__$(wahl, 3))
dlg.Nachname = (AdrArr__$(wahl, 4))
dlg.Title = (AdrArr__$(wahl, 1))
dlg.eFirma = (AdrArr__$(wahl, 5))
dlg.eAbteilung = (AdrArr__$(wahl, 6))
dlg.ePosition = (AdrArr__$(wahl, 2))
dlg.eAdresse = (AdrArr__$(wahl, 7))
dlg.eOrt = (AdrArr__$(wahl, 9))
dlg.ePLZ = (AdrArr__$(wahl, 8))
'dlg.eTelefon = AdrArr$(wahl, 10)
dlg.eFax = (AdrArr__$(wahl, 11))
dlg.eAnredeLang = (AdrArr__$(wahl, 12))
dlg.Name1 = sName1$
dlg.Name2 = sName2$
dlg.BZ1 = sZeichenSB$
dlg.BZ2 = sZeichenST$
dlg.xAbt = sAbteilung$
dlg.DW = sDurchwahl$
dlg.xFax = sFaxDW$
If netz_ = 0 Then
    Choice = WordBasic.Dialog.UserDialog(dlg, 1)
Else
    Choice = WordBasic.Dialog.UserDialog(dlg, 2)
End If
If Choice = 0 Then
'   Fehlerwert = 1
    If Beenden = 1 Then GoTo Exit_
End If
AdrArr__$(wahl, 0) = dlg.eAnredeKurz
AdrArr__$(wahl, 3) = dlg.Vorname
AdrArr__$(wahl, 4) = dlg.Nachname
AdrArr__$(wahl, 1) = dlg.Title
AdrArr__$(wahl, 5) = dlg.eFirma
AdrArr__$(wahl, 6) = dlg.eAbteilung
AdrArr__$(wahl, 2) = dlg.ePosition
AdrArr__$(wahl, 7) = dlg.eAdresse
AdrArr__$(wahl, 9) = dlg.eOrt
AdrArr__$(wahl, 8) = dlg.ePLZ
'AdrArr$(wahl, 10) = dlg.eTelefon
AdrArr__$(wahl, 11) = dlg.eFax
AdrArr__$(wahl, 12) = dlg.eAnredeLang
eAnredeKurz$ = dlg.eAnredeKurz
eVorname$ = dlg.Vorname
eNachname$ = dlg.Nachname
eTitel$ = dlg.Title
eFirma$ = dlg.eFirma
eAbteilung$ = dlg.eAbteilung
ePosition$ = dlg.ePosition
eAdresse$ = dlg.eAdresse
eOrt$ = dlg.eOrt
ePLZ$ = dlg.ePLZ
'eTelefon$ = dlg.eTelefon
eFax$ = dlg.eFax
eAnredeLang$ = dlg.eAnredeLang
sName1$ = dlg.Name1
sName2$ = dlg.Name2
sZeichenSB$ = dlg.BZ1
sZeichenST$ = dlg.BZ2
sAbteilung$ = dlg.xAbt
sDurchwahl$ = dlg.DW
sFaxDW$ = dlg.xFax
'stop

Select Case Choice
    Case 1  'Nur Brief
    Case 2  ' Brief & pers. Adreßbuch
        AdrDatei$ = AdrPfadp$ + AdrDatei$
        AdresseNeu (wahl)
    Case 3  'Brief & gem. Adreßbuch
        AdrDatei$ = AdrPfadg$ + AdrDatei$
        AdresseNeu (wahl)
    Case Else
        WordBasic.Beep
        WordBasic.PrintStatusBar "Hoppla!"
    End Select
Exit_:
End Sub



'--------------------------------AdresseLesen
Private Sub AdresseLesen(Datei$)
Dim OldDir$
OldDir$ = WordBasic.[WW2_Files$](".")
OldDir$ = WordBasic.[Left$](OldDir$, Len(OldDir$) - 1)
lz$ = Chr(13) + Chr(7)
'ChDir AdrPfad$
Documents.Open FileName:=Datei$ ', Visible:=False
'WordBasic.FileOpen Name:=Datei$
DatenFenster$ = WordBasic.[WindowName$]()
'If WordBasic.DocMaximize() = -1 Then
'    WordBasic.DocMaximize 0
'End If
'Stop
'WordBasic.DocMove 1000, 1000
'WordBasic.ScreenUpdating 0
WordBasic.StartOfDocument
If WordBasic.SelInfo(12) <> -1 Then         ' Adressen-Datei enthält Leerzeile am Beginn
    WordBasic.WW6_EditClear
End If
End Sub



'------------------------------AdresseBereit
Private Sub AdresseBereit()
Dim dummy
Dim Zelle
Dim Auswahl
Dim wahl
WordBasic.StartOfDocument
AdrAnz = WordBasic.SelInfo(15) - 1
ReDim AdrArr__$(AdrAnz, 12)
WordBasic.TableSelectRow
WordBasic.ParaDown
For dummy = 1 To AdrAnz
    WordBasic.TableSelectRow
    'ZeichRechts
    WordBasic.PrevCell
    For Zelle = 0 To 12
        If WordBasic.[Selection$]() <> lz$ Then
            AdrArr__$(dummy, Zelle) = WordBasic.[Selection$]()
        Else
            AdrArr__$(dummy, Zelle) = ""
        End If
        If Zelle < 12 Then
            WordBasic.NextCell
        End If
    Next Zelle
'   AdrArr$(dummy, Zelle) = Markierung$()
    If dummy < AdrAnz Then
        WordBasic.NextCell
    End If
Next dummy
'DokumentSchließen 2
ReDim ANamen__$(AdrAnz)
For dummy = 1 To AdrAnz
    If AdrArr__$(dummy, 4) <> "" Then
        ANamen__$(dummy - 1) = AdrArr__$(dummy, 0) + " " + AdrArr__$(dummy, 3) + " " + AdrArr__$(dummy, 4) + ", " + AdrArr__$(dummy, 5)
    Else
        ANamen__$(dummy - 1) = AdrArr__$(dummy, 0) + " " + AdrArr__$(dummy, 5) + ", " + AdrArr__$(dummy, 9)
    End If
WordBasic.PrintStatusBar ANamen__$(dummy)
Next dummy
WordBasic.BeginDialog 464, 112, "Wählen Sie einen Empfänger"
    WordBasic.Text 16, 11, 157, 12, "&Brief adressieren an:"
    WordBasic.ListBox 16, 27, 296, 79, ANamen__$(), "ANamen"
    WordBasic.OKButton 328, 7, 125, 21
    WordBasic.CancelButton 328, 31, 125, 21
WordBasic.EndDialog
Dim dlg As Object: Set dlg = WordBasic.CurValues.UserDialog
Auswahl = WordBasic.Dialog.UserDialog(dlg)
If Auswahl = 0 Then
    If Beenden = 1 Then GoTo Ende
End If
wahl = dlg.Anamen
wahl = wahl + 1
AdresseBestätigen (wahl)
Ende:
End Sub



'--------------------------------------AdresseNeu
Private Sub AdresseNeu(dummy)
Dim wahl
Dim x
Dim gesucht$
Dim zeile1
Dim vtext$
Dim n
Dim zeile2
Dim dlg As Object
Dim zahl
Dim Zelle
If neu = 1 Then AdresseLesen (AdrDatei$)
WordBasic.ScreenUpdating 0
If WordBasic.[Left$](AdrDatei$, 1) = "O" Then
    Caption$ = "gemeinsames Adreßbuch"
ElseIf WordBasic.[Left$](AdrDatei$, 1) = "C" Then
    Caption$ = "persönliches Adreßbuch"
Else
    Caption$ = "Neu"
End If
wahl = 0
ReDim aGefunden__$(AdrAnz), aZeilen__(AdrAnz)
x = 0
WordBasic.StartOfDocument
If AdrArr__$(dummy, 4) <> "" Then
    gesucht$ = AdrArr__$(dummy, 4)
    WordBasic.EditFind Find:=gesucht$, Direction:=0, WholeWord:=1
    While WordBasic.EditFindFound()
        zeile1 = WordBasic.SelInfo(13)
        vtext$ = ""
        WordBasic.StartOfRow
        WordBasic.CharLeft
        WordBasic.NextCell
        For n = 0 To 4
            If WordBasic.[Selection$]() <> lz$ Then
                vtext$ = vtext$ + " " + WordBasic.[Selection$]()
            Else
                vtext$ = vtext$ + ""
            End If
            WordBasic.NextCell
        Next n
        aGefunden__$(x) = vtext$
        aZeilen__(x) = zeile1
        x = x + 1
        WordBasic.EditFind Find:=gesucht$, Direction:=0, WholeWord:=1
        zeile2 = WordBasic.SelInfo(13)
        If zeile2 = zeile1 Then GoTo weiter
    Wend
Else
    If AdrArr__$(dummy, 5) <> "" Then
        gesucht$ = AdrArr__$(dummy, 5)
        WordBasic.EditFind Find:=gesucht$, Direction:=0, WholeWord:=1
        While WordBasic.EditFindFound()
            zeile1 = WordBasic.SelInfo(13)
            WordBasic.StartOfRow
            vtext$ = WordBasic.[Selection$]()
            WordBasic.NextCell
            WordBasic.NextCell
            WordBasic.NextCell
            WordBasic.NextCell
            vtext$ = vtext$ + " " + WordBasic.[Selection$]()
            aGefunden__$(x) = vtext$
            aZeilen__(x) = zeile1
            x = x + 1
            WordBasic.EditFind Find:=gesucht$, Direction:=0, WholeWord:=1
            zeile2 = WordBasic.SelInfo(13)
            If zeile2 = zeile1 Then GoTo weiter
        Wend
    End If
End If
weiter:
If x > 0 Then
    WordBasic.BeginDialog 372, 216, "Eintrag gefunden: " + Caption$
        WordBasic.Text 16, 51, 343, 40, "Markieren Sie in der Liste den Eintrag, den Sie ersetzen wollen, oder Hinzufügen für den neuen Eintrag.", "Text2"
        WordBasic.Text 19, 10, 324, 41, "Für die Adresse, die Sie ändern oder hinzufügen wollen, wurden ähnliche Einträge gefunden. ", "Text3"
        WordBasic.ListBox 14, 90, 337, 84, aGefunden__$(), "Listenfeld1"
        WordBasic.PushButton 14, 177, 88, 21, "Ersetzen", "Definierbar1"
        WordBasic.PushButton 143, 176, 88, 21, "Hinzufügen", "Definierbar2"
        WordBasic.CancelButton 262, 177, 88, 21
    WordBasic.EndDialog
    Set dlg = WordBasic.CurValues.UserDialog
    wahl = WordBasic.Dialog.UserDialog(dlg)
    zahl = dlg.Listenfeld1
    Select Case wahl
    Case 0
        AdresseBestätigen (dummy)
    Case 1
        WordBasic.StartOfDocument
        While WordBasic.SelInfo(13) <> aZeilen__(zahl)
            WordBasic.TableSelectRow
            WordBasic.ParaDown
        Wend
        WordBasic.StartOfRow
        WordBasic.CharLeft
        WordBasic.NextCell
        For Zelle = 0 To 12
            WordBasic.Insert AdrArr__$(dummy, Zelle)
            If Zelle < 12 Then
                WordBasic.NextCell
            End If
        Next Zelle
    Case 2
        WordBasic.TableSelectTable
        WordBasic.CharRight
        WordBasic.TableInsertRow
        For Zelle = 0 To 12
            WordBasic.Insert AdrArr__$(dummy, Zelle)
            If Zelle < 12 Then
                WordBasic.NextCell
            End If
        Next Zelle
    End Select
Else
    WordBasic.TableSelectTable
    WordBasic.CharRight
    WordBasic.TableInsertRow
    For Zelle = 0 To 12
        WordBasic.Insert AdrArr__$(dummy, Zelle)
        If Zelle < 12 Then
            WordBasic.NextCell
        End If
    Next Zelle

End If
'Aktivieren DatenFenster$
WordBasic.TableSelectTable
If WordBasic.SelInfo(15) > 2 Then
    WordBasic.TableSort Order:=0, FieldNum:=4, _
Type:=0, Order2:=0, FieldNum2:=5, _
Type2:=0, DontSortHdr:=1
End If
'Exit:
End Sub


'----------------------------Beenden----------------

Private Function Beenden()
Dim n
n = WordBasic.MsgBox("Wollen Sie tatsächlich abbrechen", "Adressen-Verwaltung", 32 + 4)
If n = -1 Then
    Fehlerwert = 2
'   DateiAllesSchließen 2
'   DateiNeuStandard
    Beenden = 1
Else
    Beenden = 0
End If
End Function


Attribute VB_Name = "BriefStarten"

Public Sub main()
Attribute main.VB_Description = "neuer CD-Brief"
Attribute main.VB_ProcData.VB_Invoke_Func = "Normal.BriefStarten.MAIN"
WordBasic.FileNew NewTemplate:=0, Template:="CDBRIEF"
End Sub

Attribute VB_Name = "DocMinimize"

Public Sub main() '********   WINMAX.DOT: DocMinimize ********
Attribute main.VB_Description = "Makes a document window its smallest possible size and moves it to the bottom right corner of the screen"
Attribute main.VB_ProcData.VB_Invoke_Func = "Normal.DocMinimize.MAIN"
Dim WinWd
Dim WinHt
'**************************************************************
'*  Verkleinert ein Dokument-Fenster auf die kleinste mögliche Größe und    *
'*  verschiebt es dann in die untere rechte Ecke.               *
'**************************************************************

'*****  Ermittelt aktuelle Fenstergröße *****
WinWd = WordBasic.Val(WordBasic.[AppInfo$](6)): WinHt = WordBasic.Val(WordBasic.[AppInfo$](7))

If WordBasic.DocMaximize() Then WordBasic.DocRestore    'Wenn Fenster Maximumgröße dann Wiederherstellen

'*****  Bewege Fenster in unterer rechte Ecke des Bildschirms.
'*****  Verwende Länge des Dateinamens um geringste Breite festzustellen
WordBasic.DocMove WinWd - 90 - (Len(WordBasic.[FileName$](0)) * 5) - ((WordBasic.Window() - 1) * 16), _
    (WinHt - 99 - ((WordBasic.Window() - 1) * 20))
'*****  Verwende Länge des Dateinamens um geringste Breite festzustellen
WordBasic.DocSize 1 + (Len(WordBasic.[FileName$](0)) * 8), 1

End Sub


Attribute VB_Name = "BenutzerNeu"

Rem BenutzerDatenNeu - Neue Version von BenutzerInfo
Rem AWB/rei, 21.02.95
Rem Letzte Änderung: 19.06.95/rei
Rem Variablen in der WIN.INI
Rem 5.05.97: Schreibstube startet nicht die Referenten-Verwaltung
Rem 30.07.97: Bre-Kennzeichen kann eingegeben werden
'11.01.2001: Anpassung für Office2000

Rem Name, Firma, Standort, Geschäftsbereich, Abteilung Adresse, Briefanschrift, Ort, Vorwahl, PLZ, Telefon, Durchwahl, Fax,
Dim sName1$, sName2$, sFirma$, sStandort$, sGbereich$, sAbteilung$, sAdresse$, sPostfach$, sOrt$, sVorwahl$, sPLZ$, sTelefon$, sDurchwahl$, sFax$, sTelegramm$, sZeichenSB$, sBreKZ$
Dim sZeichenST$, TheAddress$, sFaxDW$, Fehlerwert, BenutzerArt, sBenutzerArt$, sGeschlecht$, sBank$

Public Sub main()
Attribute main.VB_Description = "BenutzerDaten erfassen"
Attribute main.VB_ProcData.VB_Invoke_Func = "Normal.BenutzerNeu.MAIN"
Dim CrLf$
Dim Sonstiges$
sName1$ = ""
sName2$ = ""
sFirma$ = ""
sStandort$ = ""
sGbereich$ = ""
sAbteilung$ = ""
sAdresse$ = ""
sPostfach$ = ""
sOrt$ = ""
sVorwahl$ = ""
sPLZ$ = ""
sTelefon$ = ""
sDurchwahl$ = ""
sFax$ = ""
sTelegramm$ = ""
sZeichenSB$ = ""
sBreKZ$ = ""
sZeichenST$ = ""
TheAddress$ = ""
sFaxDW$ = ""
Fehlerwert = 0
BenutzerArt = 0
sBenutzerArt$ = ""
sGeschlecht$ = ""
sBank$ = ""
Fehlerwert = 0
sBenutzerArt$ = WordBasic.[GetProfileString$]("MS Word User", "BenutzerArt")
BenutzerArt = WordBasic.Val(sBenutzerArt$)
Benutzer1
If BenutzerArt < 3 Then
    BenutzerArt = BenutzerArtFestlegen(BenutzerArt)
    sBenutzerArt$ = WordBasic.[Right$](Str(BenutzerArt), 1)
    If Fehlerwert = 1 Then GoTo Bye
End If
Select Case BenutzerArt
    Case 0  'selbstschreibender Sachbearbeiter
        BearbeiterDaten
    Case 1  'Sekretariat
        PersDatenEingeben
    Case 2  'Schreibstube
        SchreibstubenDaten
    Case 3  'Außendienst, wird in der WIN.INI fix codiert
        Außendienst
End Select
If Fehlerwert = 1 Then GoTo Bye
FirmenMaske "Firmen-Daten eingeben:"
If Fehlerwert = 1 Then GoTo Bye
Rem If BenutzerArt = 2 Then
Rem     ReferentenVerwaltung
Rem End If
If Fehlerwert = 1 Then GoTo Bye
CrLf$ = Chr(13) + Chr(10)
Sonstiges$ = sTelefon$ + CrLf$ + sDurchwahl$ + CrLf$ + sFax$ + CrLf$ + sZeichenSB$ + CrLf$ + sZeichenST$
'If fConfirmSenderInfo(TheAddress$, Sonstiges$) = 0 Then
'   InfoAendern
'End If
If Fehlerwert = 1 Then GoTo Bye
EinstellungenSpeichern


Bye:
WordBasic.PrintStatusBar ""
End Sub



'----------------------------Benutzer1-------------------------
Private Sub Benutzer1()
Dim sTelex$
Dim sGesellschaft$
If WordBasic.[GetProfileString$]("MS Word User", "Firma") = "" Then
    PrepareUserForDlg
    If BenutzerArt = 3 Then
        sName1$ = "Ihr Name"
        sName2$ = "Allianz Betreuer"
        sAbteilung$ = ""
        sStandort$ = "Geschäftsstelle"
        sGbereich$ = ""
    Else
        sName1$ = "Name des Verantwortlichen"
        sName2$ = "SekretärIn/SachbearbeiterIn"
        sAbteilung$ = "Abteilung"
        sStandort$ = "Generaldirektion"
        sGbereich$ = "Industrie- und Großkunden"
    End If
    sFirma$ = "Wiener Allianz"
    sAdresse$ = "Hietzinger Kai 101-105"
    sPostfach$ = "1500"
    sOrt$ = "Wien"
    sPLZ$ = "A-"
'   sPLZb$ = "1131"
    sVorwahl$ = "(01)"
    sTelefon$ = "87807"
'   sTelex$ = "132355"
    sTelegramm$ = "Allianz Wien"
Else
    sName1$ = WordBasic.[GetProfileString$]("MS Word User", "Name1")
…

Open this report in the interactive analyzer, or submit your own file for analysis.