Programming Tool Box/SIMS_2.iso/code/cdspy/my2.bas

BASIC Source File | 1995-02-13 | 46KB | 1,527 lines

Option Explicit

Type TM_OutlineRec
  Bezeichnung As String * 25
  hat_unter_obj As Integer
  Vaterobj As Long
  Kind As Long
  Vor As Long
  Nach As Long
  Pfad As String * 128
  Ebene As Integer
  Visible As Integer
End Type

Type TM_DBRec
  Bezeichnung As String * 25
  Vater As Long
  Verzeichnis As String * 128
  Code As Integer
End Type

Global GM_Outline() As TM_OutlineRec
Global GM_DB As TM_DBRec

Global Const GCM_INFOFILENAME = "CDINFO.TXT"
Global Const GCM_VERZEICHNIS = "VERZEICHNIS="
Global Const GCM_PROJEKT = "PROJEKT="
Global Const GCM_INFO = "INFO="
Global Const GCM_DEMO = "DEMO="
Global Const GCM_INSTALL = "INSTALL="
Global Const GCM_DBNAME = "SPY.DAT"
Global Const GCM_EINSTELLUNGEN = "Einstellungen"
Global Const GCM_SEPERATOR = ","
' SchaltflΣchen im Cmd_Array
Global Const GCM_CMD_INFO = 0
Global Const GCM_CMD_DEMO = 1
Global Const GCM_CMD_COPY = 2
Global Const GCM_CMD_INSTALL = 3
Global Const GCM_CMD_CODE = 4
Global Const GCM_CMD_HILFE = 5


Global GM_DBAll() As TM_DBRec

Declare Function SendMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
Declare Function GetModuleUsage Lib "KERNEL" (ByVal InstanceID%) As Integer


Global G_CDInfoFile As String

Global G_Control As Control
Global G_EditFile As String

Function ExistDir% (drn$)
  Dim temp$
  On Error Resume Next
  temp$ = Dir$(drn$, 16)
  If Err <> 0 Or temp$ = "" Then
    ExistDir% = False
  Else
    ExistDir% = True
  End If
End Function

Function exists (dn$) As Integer
  Dim temp$
  On Error Resume Next
  temp$ = Dir$(dn$, 32)
  exists = Not (Err <> 0 Or temp$ = "")
End Function

Function FM_LiesDB (ID&)
  Dim fd As Integer
  If ID < 1 Then
    Exit Function
  End If
  fd = FreeFile
  Open GCM_DBNAME For Random As fd Len = Len(GM_DB)
  If ID& * Len(GM_DB) <= LOF(fd) Then
    Get #fd, ID&, GM_DB
    FM_LiesDB = ID&
  Else
    FM_LiesDB = 0
  End If
  Close fd
End Function

Function FM_Max (X, y)
  If X > y Then
    FM_Max = X
  Else
    FM_Max = y
  End If
End Function

Function FM_Min (X, y)
  If X < y Then
    FM_Min = X
  Else
    FM_Min = y
  End If
End Function

' --------------------------------------------------------
' Die Funktion Parse_Zeile liefert aus einer gegebenen
' Zeile die Zeichenkette bis zum ersten Zeichen ch$ zurⁿck
' und reduziert die Zeile auf den nachfolgenden Teil der
' Zeile ▄ber den Parameter z$ wird die Zeile zur Initia-
' lisierung ⁿbergeben. Zum Abrufen der Werte wird ein
' Leerstring als z$ ⁿbergeben
' --------------------------------------------------------
Function FM_ParseZeile$ (z$, ch$)
  Static txt$, Zch$
  Dim tmp$

  If z$ <> "" Then
    ' Zeile initialisieren
    txt$ = z$ + ch$
    Zch$ = ch$
  End If
  If Trim$(txt$) <> "" Then
    ' Zeichenkette bis zum ersten Tabulatorzeichen bestimmen
    tmp$ = Left$(txt$, InStr(txt$, Zch$) - 1)
    ' Zeile auf Teil nach erstem Tabulatorzeichen reduzieren
    txt$ = LTrim$(Mid$(txt$, InStr(txt$, Zch$) + 1))
  End If
  FM_ParseZeile$ = tmp$
End Function

Function FM_SchreibDB ()
  Dim fd As Integer
  Dim pos%
  fd = FreeFile
  Open GCM_DBNAME For Random As fd Len = Len(GM_DB)
  pos% = (LOF(fd) / Len(GM_DB)) + 1
  Put #fd, pos%, GM_DB
  FM_SchreibDB = pos%
  Close fd
End Function

Function FM_Verz$ (Verz$)
  Dim tmp$
  tmp$ = Trim$(Verz$)
  If Right$(tmp$, 1) <> "\" Then
    tmp$ = tmp$ + "\"
  End If
  FM_Verz$ = tmp$
End Function

Sub ListSubDirs (path$, d() As TM_DBRec)
  Const ATTR_DIRECTORY = 16
  Dim position%, Count%, Vater%

  Dim I, dirname

  On Error Resume Next
  If Right$(path$, 1) <> "\" Then path$ = path$ + "\"
  If ExistDir(path$) Then
    position% = 1
    Count% = 1
    dirname = Dir(path, ATTR_DIRECTORY) ' Erster Verzeichnisname

    'Alle Verzeichnisse innerhalb dieses Verzeichnisses in D() speichern
    ReDim d(Count%)
    d(Count%).Verzeichnis$ = path$
    d(Count%).Vater = 0
    PM_GetCDINFO d(Count%)
    Count% = Count% + 1
    Do
      Do While dirname <> ""
        DoEvents
        If dirname <> "." And dirname <> ".." Then
          If (GetAttr(path + dirname) And ATTR_DIRECTORY) = ATTR_DIRECTORY Then
            ReDim Preserve d(Count%)
            d(Count%).Verzeichnis = path + dirname
            d(Count%).Vater = position%
            PM_GetCDINFO d(Count%)
            Count% = Count% + 1
          End If
        End If
        dirname = Dir   ' Get another directory name.
      Loop
      position% = position% + 1
      If position% >= Count% Then Exit Do
      path$ = Trim$(d(position%).Verzeichnis$) + "\"
      dirname = Dir(path, ATTR_DIRECTORY)
    Loop
  End If
End Sub

Sub PM_ChangeCmdState (index%)
  Static old%
  Dim Res&
  If Haupt!Cmd_Array(index%).Enabled Then
    Res& = SendMessage(Haupt!Cmd_Array(index%).hWnd, &H403, -1, 0)
  Else
    Res& = SendMessage(Haupt!Cmd_Array(index%).hWnd, &H403, 0, 0)
  End If
  If old% = index% Then Exit Sub
  Res& = SendMessage(Haupt!Cmd_Array(old%).hWnd, &H403, 0, 0)
  old% = index%
End Sub

Sub PM_ClearDB ()
  Dim fd As Integer
  fd = FreeFile
  Kill GCM_DBNAME
End Sub

Sub PM_EditFile (dn$)
  Dim fd As Integer
  Dim L_LengthOfFile%
  Dim tmp$
  fd = FreeFile
  L_LengthOfFile% = FileLen(dn$)
  tmp$ = Space$(L_LengthOfFile%)
  Open dn$ For Binary As fd Len = L_LengthOfFile%
  Get fd, 1, tmp$
  G_EditFile$ = tmp$
  Close fd
  EditFile.Caption = dn$
  EditFile.Show
End Sub

Sub PM_GenerateDB (Pfad$)
  Dim I%, Res%
  If ExistDir(Pfad$) Then
    PM_ClearDB
    ListSubDirs Pfad$, GM_DBAll()
    For I% = 1 To UBound(GM_DBAll)
      GM_DB = GM_DBAll(I%)
      Res% = FM_SchreibDB()
    Next I%
  End If
End Sub

Sub PM_GetCDINFO (d As TM_DBRec)
  Dim tmp$, fd%, Zeile$, pos%
  tmp$ = Trim$(d.Verzeichnis$)
  If Right$(tmp$, 1) <> "\" Then tmp$ = tmp$ + "\"
  tmp$ = Trim$(tmp$) + "CDINFO.TXT"
  fd = FreeFile
  On Error Resume Next
  Open tmp$ For Input As fd
  If Err <> 0 Then Exit Sub
  If Not EOF(fd) Then
    Line Input #fd, Zeile$
    pos% = InStr(UCase$(Zeile$), GCM_VERZEICHNIS)
    If pos% Then
      d.Bezeichnung$ = Mid$(Zeile$, pos% + Len(GCM_VERZEICHNIS))
    End If
    If Not EOF(fd) Then
      Line Input #fd, Zeile$
      pos% = InStr(UCase$(Zeile$), GCM_PROJEKT)
      If pos% Then
        d.Code = 1
      Else
        d.Code = 0
      End If
    End If
  End If
  Close fd
End Sub

Sub PM_GetChilds (ID&, d())
  Dim fd As Integer
  Dim I%
  fd = FreeFile
  Open GCM_DBNAME For Random As fd Len = Len(GM_DB)
  For I% = 1 To LOF(fd) / Len(GM_DB)
    Get #fd, I%, GM_DB
    If GM_DB.Vater = ID& Then
      d(UBound(d)) = I%
      ReDim Preserve d(UBound(d) + 1)
    End If
  Next I%
  Close fd
End Sub

Sub PM_GetFileInfo (dn$)
  Dim ds As Integer
  Dim pos%
  Dim Zeile$
  Dim Ub%
  ds = FreeFile
  Open dn$ For Input As ds
  Line Input #ds, Zeile$
  pos% = InStr(Zeile$, GCM_VERZEICHNIS)
  If pos% Then ' Verzeichnis
    On Error Resume Next
    Ub% = UBound(GM_Outline)
    On Error GoTo 0
    Ub% = Ub% + 1
    ReDim Preserve GM_Outline(Ub%)
    GM_Outline(Ub%).Bezeichnung = Mid$(Zeile$, pos% + Len(GCM_VERZEICHNIS))
  End If
  If Not EOF(ds) Then
    Line Input #ds, Zeile$
    pos% = InStr(Zeile$, GCM_PROJEKT)
    If pos% Then
      GM_Outline(Ub%).hat_unter_obj = False
    Else
      GM_Outline(Ub%).hat_unter_obj = True
    End If
  Else
    GM_Outline(Ub%).hat_unter_obj = True
  End If
  Close #ds
End Sub

Sub PM_GetParents (ID&, d())
  Dim fd As Integer
  Dim I%
  fd = FreeFile
  Open GCM_DBNAME For Random As fd Len = Len(GM_DB)
  For I% = 1 To LOF(fd) / Len(GM_DB)
    Get #fd, I%, GM_DB
    If GM_DB.Vater = ID& Then
      d(UBound(d)) = I%
      ReDim Preserve d(UBound(d) + 1)
    End If
  Next I%
  Close fd
End Sub

Sub PM_LeseEintrag (index As Long, ByVal ID As Long, Ebene%)
  Dim Vater&
  Dim LM_DB As TM_DBRec
  Dim tmpIndex&
  ReDim d(1)
  Dim cnt%, I%, Res%
  Res% = FM_LiesDB(ID&)
  LM_DB = GM_DB
  If ID > 0 Then
    PM_LeseEintrag index&, LM_DB.Vater&, Ebene%
    PM_GetParents ID&, d()
    For I% = 1 To UBound(d) - 1
      Res% = FM_LiesDB(CLng(d(I%)))
      If Res% <> 0 Then
        Haupt.Outline.AddItem GM_DB.Bezeichnung, index
        Haupt.Outline.ItemData(index) = Res%
        Haupt.Outline.Indent(index) = Ebene%
        If Not GM_DB.Code Then
          Haupt.Outline.PictureType(index&) = 0
        Else
          Haupt.Outline.PictureType(index&) = 2
        End If
        If Haupt.Outline.ItemData(index) = LM_DB.Vater& Then
          tmpIndex& = index&
          Haupt.Outline.Expand(index&) = True
        End If
        index& = index& + 1
      End If
    Next I%

    If tmpIndex& <> 0 Then index& = tmpIndex& + 1
  Else
    Res% = FM_LiesDB(1)
    Ebene% = 1
    If Res% <> 0 Then
      Haupt.Outline.AddItem GM_DB.Bezeichnung, index
      Haupt.Outline.ItemData(index) = Res%
      Haupt.Outline.Indent(index) = Ebene%
      If Not GM_DB.Code Then
        Haupt.Outline.PictureType(index&) = 0
      Else
        Haupt.Outline.PictureType(index&) = 2
      End If
      If Haupt.Outline.ItemData(index) = LM_DB.Vater& Then
        Haupt.Outline.Expand(index&) = True
        tmpIndex& = index&
      End If
      index& = index& + 1
    End If
  End If
  Ebene% = Ebene% + 1
End Sub

Sub PM_Lies (ID&)
  Dim index&
  Dim Ebene%
  index& = 0
  Haupt.Outline.Clear
  PM_LeseEintrag index&, ID&, Ebene%
End Sub

Sub PM_LiesCDInfo (Verzeichnis$)
  Dim fd As Integer
  Dim l&
  Dim L_CDInfoFilename$
  If Right$(Verzeichnis$, 1) <> "\" Then
    L_CDInfoFilename$ = Verzeichnis$ + "\" + GCM_INFOFILENAME
  Else
    L_CDInfoFilename$ = Verzeichnis$ + GCM_INFOFILENAME
  End If
  l& = FileLen(L_CDInfoFilename$)
  G_CDInfoFile$ = Space$(l&)
  fd = FreeFile
  Open L_CDInfoFilename$ For Binary As fd Len = l&
  Get #fd, , G_CDInfoFile$
  Close fd
End Sub

' --------------------------------------------------------
' Liest die ben÷tigten Control-Informationen aus dem
' Initialisierungsfile
' --------------------------------------------------------
' Autor   : NM/ag
' Datum   : 10.2.94
' Version : 1.0
' --------------------------------------------------------
Sub PM_LiesControl (Ctrl As Control)
  Dim L_Ini_Zeile$, Eigenschaft$
  L_Ini_Zeile$ = F_GetPrivatIni("Einstellungen", Ctrl.Tag)
  Eigenschaft$ = FM_ParseZeile$((L_Ini_Zeile$), GCM_SEPERATOR)
  If TypeOf Ctrl Is Label Then
    If Eigenschaft$ = "" Then Exit Sub
    Ctrl.FontName = Eigenschaft$
    Eigenschaft$ = FM_ParseZeile$("", "")
    If Eigenschaft$ = "" Then Exit Sub
    Ctrl.FontSize = Val(Eigenschaft$)
    Eigenschaft$ = FM_ParseZeile$("", "")
    If Eigenschaft$ = "" Then Exit Sub
    Ctrl.FontBold = Val(Eigenschaft$)
    Eigenschaft$ = FM_ParseZeile$("", "")
    If Eigenschaft$ = "" Then Exit Sub
    Ctrl.ForeColor = Val(Eigenschaft$)
    Eigenschaft$ = FM_ParseZeile$("", "")
    If Eigenschaft$ = "" Then Exit Sub
    Ctrl.BackColor = Val(Eigenschaft$)
  Else
    If Eigenschaft$ = "" Then Exit Sub
    Ctrl.FontName = Eigenschaft$
    Eigenschaft$ = FM_ParseZeile$("", "")
    If Eigenschaft$ = "" Then Exit Sub
    Ctrl.FontSize = Val(Eigenschaft$)
    Eigenschaft$ = FM_ParseZeile$("", "")
    If Eigenschaft$ = "" Then Exit Sub
    Ctrl.FontBold = Val(Eigenschaft$)
    Eigenschaft$ = FM_ParseZeile$("", "")
    If Eigenschaft$ = "" Then Exit Sub
    Ctrl.ForeColor = Val(Eigenschaft$)
    Eigenschaft$ = FM_ParseZeile$("", "")
    If Eigenschaft$ = "" Then Exit Sub
    Ctrl.BackColor = Val(Eigenschaft$)
  End If
End Sub

' --------------------------------------------------------
' Liest die ben÷tigten Formular-Informationen aus dem
' Initialisierungsfile
' --------------------------------------------------------
' Autor   : NM/ag
' Datum   : 10.2.94
' Version : 1.0
' --------------------------------------------------------
Sub PM_LiesForm (Frm As Form)
  Dim L_Ini_Zeile$, Eigenschaft$
  L_Ini_Zeile$ = F_GetPrivatIni("Einstellungen", Frm.Tag)
  Eigenschaft$ = FM_ParseZeile$((L_Ini_Zeile$), GCM_SEPERATOR)
  If Eigenschaft$ = "" Then Exit Sub
  Frm.Top = Val(Eigenschaft$)
  Eigenschaft$ = FM_ParseZeile$("", "")
  If Eigenschaft$ = "" Then Exit Sub
  Frm.Left = Val(Eigenschaft$)
  Eigenschaft$ = FM_ParseZeile$("", "")
  If Eigenschaft$ = "" Then Exit Sub
  Frm.Width = Val(Eigenschaft$)
  Eigenschaft$ = FM_ParseZeile$("", "")
  If Eigenschaft$ = "" Then Exit Sub
  Frm.Height = Val(Eigenschaft$)
  Eigenschaft$ = FM_ParseZeile$("", "")
  If Eigenschaft$ = "" Then Exit Sub
  Frm.WindowState = Val(Eigenschaft$)
End Sub

Sub PM_LiesOutline (pos%)
  Dim fd As Integer
  fd = FreeFile
  Open GCM_DBNAME For Random As fd Len = Len(GM_DB)
  Get fd, pos%, GM_DB
  Haupt.Outline.AddItem GM_DB.Bezeichnung
  Haupt.Outline.ItemData(0) = pos%
  Haupt.Outline.Indent(1) = 2
  Close fd
  Haupt.Outline.Refresh
End Sub

Sub PM_ReadCDInfo ()
  Dim Res&
  Dim pos%
  Dim L_CDInfoCommands$
  Dim tmp$
  Dim MakDatei$, HilfeDatei$
  Res& = FM_LiesDB(Val(Haupt!Outline.ItemData(Haupt!Outline.ListIndex)))
  PM_LiesCDInfo Trim$(GM_DB.Verzeichnis$)
  pos% = InStr(UCase$(G_CDInfoFile$), GCM_INFO)
  If pos% <> 0 Then
    Haupt!Lbl_Info.Caption = Mid$(G_CDInfoFile$, pos% + Len(GCM_INFO))
    Haupt!Lbl_Info.Visible = True
    Haupt!Cmd_Array(GCM_CMD_INFO).Enabled = True
    Haupt!Cmd_Array(GCM_CMD_INFO) = True
    L_CDInfoCommands$ = UCase$(Left$(G_CDInfoFile$, pos% - 1))
  Else
    Haupt!Cmd_Array(GCM_CMD_INFO).Enabled = False
    Haupt!Lbl_Info.Visible = False
    Haupt!Lbl_Info.Caption = ""
    Haupt!Cmd_Array(6) = True
    L_CDInfoCommands$ = UCase$(G_CDInfoFile$)
  End If
  pos% = InStr(L_CDInfoCommands$, GCM_DEMO)
  If pos% <> 0 Then
    Haupt!Cmd_Array(GCM_CMD_DEMO).Enabled = True
    tmp$ = Mid$(L_CDInfoCommands$ + Chr$(13), pos% + Len(GCM_DEMO))
    Haupt!Cmd_Array(GCM_CMD_DEMO).Tag = Left$(tmp$, InStr(tmp$, Chr$(13)) - 1)
  Else
    Haupt!Cmd_Array(GCM_CMD_DEMO).Enabled = False
  End If
  pos% = InStr(L_CDInfoCommands$, GCM_PROJEKT)
  If pos% <> 0 Then
    Haupt!Cmd_Array(GCM_CMD_COPY).Enabled = True
  Else
    Haupt!Cmd_Array(GCM_CMD_COPY).Enabled = False
  End If
  tmp$ = FM_Verz$(GM_DB.Verzeichnis$) + "*.MAK"
  MakDatei$ = Dir$(tmp$)
  If MakDatei$ <> "" Then
    Haupt!Cmd_Array(GCM_CMD_CODE).Enabled = True
    Haupt!Cmd_Array(GCM_CMD_CODE).Tag = FM_Verz$(GM_DB.Verzeichnis$)
  Else
    Haupt!Cmd_Array(GCM_CMD_CODE).Enabled = False
  End If
  pos% = InStr(L_CDInfoCommands$, GCM_INSTALL)
  If pos% <> 0 Then
    Haupt!Cmd_Array(GCM_CMD_INSTALL).Enabled = True
    tmp$ = Mid$(L_CDInfoCommands$ + Chr$(13), pos% + Len(GCM_INSTALL))
    Haupt!Cmd_Array(GCM_CMD_INSTALL).Tag = Left$(tmp$, InStr(tmp$, Chr$(13)) - 1)
  Else
    Haupt!Cmd_Array(GCM_CMD_INSTALL).Enabled = False
  End If
  tmp$ = FM_Verz$(GM_DB.Verzeichnis$) + "*.HLP"
  HilfeDatei$ = Dir$(tmp$)
  If HilfeDatei$ <> "" Then
    Haupt!Cmd_Array(GCM_CMD_HILFE).Enabled = True
    Haupt!Cmd_Array(GCM_CMD_HILFE).Tag = "WinHelp " & FM_Verz$(GM_DB.Verzeichnis$) & HilfeDatei$
  Else
    Haupt!Cmd_Array(GCM_CMD_HILFE).Enabled = False
  End If
  PM_ChangeCmdState (0)
End Sub

Sub PM_ReadItems (ByVal Vater&, ByVal ListIndex%, ByVal Ebene%)
  ReDim d(1)
  Dim cnt%, I%, Res%
  PM_GetParents Vater&, d()
  For I% = 1 To UBound(d) - 1
    Res% = FM_LiesDB(CLng(d(I%)))
    If Res% <> 0 Then
      ListIndex% = ListIndex% + 1
      If ListIndex% < Haupt.Outline.ListCount Then
        If Haupt.Outline.List(ListIndex%) = "Hilfs" Then
          Haupt.Outline.List(ListIndex%) = GM_DB.Bezeichnung$
        Else
          Haupt.Outline.AddItem GM_DB.Bezeichnung, ListIndex%
        End If
      Else
        Haupt.Outline.AddItem GM_DB.Bezeichnung, ListIndex%
      End If
      Haupt.Outline.ItemData(ListIndex%) = Res%
      Haupt.Outline.Indent(ListIndex%) = Ebene%
      If GM_DB.Code = 0 Then
        Haupt.Outline.PictureType(ListIndex%) = 0
        ListIndex% = ListIndex% + 1
        Haupt.Outline.AddItem "Hilfs", ListIndex%
        Haupt.Outline.Indent(ListIndex%) = Ebene% + 1
      Else
        Haupt.Outline.PictureType(ListIndex%) = 2
      End If
    End If
  Next I%
End Sub

Sub PM_RefreshAnzeige ()
  Haupt!Lbl_Info.Move 4, 2
  Haupt!Lbl_Info.Height = Haupt!Pic_Anzeige.Height - 4
  Haupt!Lbl_Info.Width = FM_Max(Haupt!Pic_Anzeige.Width - 6, 0)
  Haupt!File1.Move 4, 2
  Haupt!File1.Width = Haupt!Lbl_Info.Width
  Haupt!File1.Height = Haupt!Lbl_Info.Height
  If Haupt!Lbl_Info.Visible Then
    Haupt!Pic_Anzeige.BackColor = Haupt!Lbl_Info.BackColor
  Else
    Haupt!Pic_Anzeige.BackColor = Haupt!File1.BackColor
  End If
End Sub

Sub PM_ScanDirs (Pfad$, Vater&)
  Dim tmp$, Vater_Neu&, totPfad$
  GM_DB.Bezeichnung$ = "Test"
  GM_DB.Vater& = Vater&
  GM_DB.Verzeichnis$ = Pfad$
  Debug.Print Pfad$
  Vater_Neu& = FM_SchreibDB()
  If Right$(Pfad$, 1) <> "\" Then
    totPfad$ = Pfad$ + "\"
  Else
    totPfad$ = Pfad$ + ""
  End If
  tmp$ = Dir$(totPfad$ + "*.*", 16)
  Do While Left$(tmp$, 1) = "."
    tmp$ = Dir$
  Loop
  Do While tmp$ <> ""
    If GetAttr(totPfad$ + tmp$) = 16 Then ' Verzeichnis
      PM_ScanDirs totPfad$ + tmp$, Vater_Neu&
    End If
    tmp$ = Dir$
  Loop
End Sub

' --------------------------------------------------------
' Speichert die ben÷tigten Control-Informationen im
' Initialisierungsfile ab
' --------------------------------------------------------
' Autor   : NM/ag
' Datum   : 10.2.94
' Version : 1.0
' --------------------------------------------------------
Sub PM_SchreibControl (Ctrl As Control)
  Dim L_Ini_Zeile$
  If TypeOf Ctrl Is Label Then
    L_Ini_Zeile$ = Ctrl.FontName & GCM_SEPERATOR
    L_Ini_Zeile$ = L_Ini_Zeile$ & Trim$(Str$(Ctrl.FontSize)) & GCM_SEPERATOR
    L_Ini_Zeile$ = L_Ini_Zeile$ & Ctrl.FontBold & GCM_SEPERATOR
    L_Ini_Zeile$ = L_Ini_Zeile$ & Ctrl.ForeColor & GCM_SEPERATOR
    L_Ini_Zeile$ = L_Ini_Zeile$ & Ctrl.BackColor
  Else
    L_Ini_Zeile$ = Ctrl.FontName & GCM_SEPERATOR
    L_Ini_Zeile$ = L_Ini_Zeile$ & Trim$(Str$(Ctrl.FontSize)) & GCM_SEPERATOR
    L_Ini_Zeile$ = L_Ini_Zeile$ & Ctrl.FontBold & GCM_SEPERATOR
    L_Ini_Zeile$ = L_Ini_Zeile$ & Ctrl.ForeColor & GCM_SEPERATOR
    L_Ini_Zeile$ = L_Ini_Zeile$ & Ctrl.BackColor
  End If
  P_WritePrivatInit GCM_EINSTELLUNGEN, (Ctrl.Tag), L_Ini_Zeile$
End Sub

' --------------------------------------------------------
' Speichert die ben÷tigten Formular-Informationen im
' Initialisierungsfile ab
' --------------------------------------------------------
' Autor   : NM/ag
' Datum   : 10.2.94
' Version : 1.0
' --------------------------------------------------------
Sub PM_SchreibForm (Frm As Form)
  Dim L_Ini_Zeile$, L_tmp_State%
  L_tmp_State% = Frm.WindowState
  Frm.WindowState = 0
  L_Ini_Zeile$ = Frm.Top & GCM_SEPERATOR
  L_Ini_Zeile$ = L_Ini_Zeile$ & Frm.Left & GCM_SEPERATOR
  L_Ini_Zeile$ = L_Ini_Zeile$ & Frm.Width & GCM_SEPERATOR
  L_Ini_Zeile$ = L_Ini_Zeile$ & Frm.Height & GCM_SEPERATOR
  L_Ini_Zeile$ = L_Ini_Zeile$ & L_tmp_State%
  P_WritePrivatInit GCM_EINSTELLUNGEN, (Frm.Tag), L_Ini_Zeile$
End Sub

Sub PM_SeekList (Cntrl As Control, Eintrag$)
  Dim I%
  For I% = 0 To Cntrl.ListCount - 1
    If Cntrl.List(I%) = Eintrag Then
      Cntrl.ListIndex = I%
      Exit For
    End If
  Next I%
End Sub

Sub PM_ShellAndWait (CommandString$)
  Dim ID%
  Dim X%
  ID% = Shell(CommandString$, 1)
  Do
    DoEvents
    Debug.Print Timer
  Loop Until GetModuleUsage(ID%) = 0
End Sub

Sub PM_Show3D (Frm As Form)
' Colors

Const BLACK = &H0&
Const WHITE = &HFFFFFF
Const GRAY = &HC0C0C0
Const DGRAY = &H808080

Dim ct As Control
Dim I As Integer
Dim Tx As Integer
Dim Ty As Integer

Tx = 1
Ty = 1
Frm.AutoRedraw = True

' Zeichne Formular
Frm.BackColor = &HC0C0C0
If Frm.BorderStyle = 0 Or Frm.BorderStyle = 1 Or Frm.BorderStyle = 3 Then
    Frm.DrawWidth = 2
    Frm.Line (0, 0)-(Frm.ScaleWidth, Frm.ScaleHeight), DGRAY, B
    Frm.DrawWidth = 1
    Frm.Line (0, 0)-(Frm.ScaleWidth, Frm.ScaleHeight), WHITE, B
End If

For I = 0 To Frm.Controls.Count - 1
    Set ct = Frm.Controls(I)
    If TypeOf ct Is Shape Then
        ct.Visible = False
        Frm.DrawWidth = 2
        Frm.Line (ct.Left - (0 * Tx), ct.Top - (0 * Ty))-(ct.Width + (1 * Tx) + ct.Left, ct.Top + ct.Height + (0 * Ty)), DGRAY, B
        Frm.DrawWidth = 1
        Frm.Line (ct.Left - (1 * Tx), ct.Top - (1 * Ty))-(ct.Width + (0 * Tx) + ct.Left, ct.Top + ct.Height - (1 * Ty)), WHITE, B
    End If
    If TypeOf ct Is Label Then

        Frm.FontSize = ct.FontSize
        Frm.FontName = ct.FontName
        Frm.FontBold = ct.FontBold
        ct.Visible = False
        Frm.CurrentX = ct.Left + Tx
        Frm.CurrentY = ct.Top + Ty
        Frm.ForeColor = WHITE
        Frm.Print ct.Caption
        Frm.CurrentX = ct.Left
        Frm.CurrentY = ct.Top
        Frm.ForeColor = BLACK
        Frm.Print ct.Caption
        ct.Visible = True
    End If
    If TypeOf ct Is TextBox Then
        Frm.Line (ct.Left + (1 * Tx), ct.Top + (1 * Ty))-(ct.Width + (0 * Tx) + ct.Left, ct.Top + ct.Height + (0 * Ty)), WHITE, B
        Frm.Line (ct.Left - (1 * Tx), ct.Top - (1 * Ty))-(ct.Width + (1 * Tx) + ct.Left, ct.Top + ct.Height + (1 * Ty)), DGRAY, B
        Frm.Line (ct.Left - (2 * Tx), ct.Top - (2 * Ty))-(ct.Width + ct.Left + (1 * Tx), ct.Top + ct.Height + (1 * Ty)), GRAY, B
    End If
    If TypeOf ct Is ListBox Then
        Frm.Line (ct.Left + (1 * Tx), ct.Top + (1 * Ty))-(ct.Width + (0 * Tx) + ct.Left, ct.Top + ct.Height + (0 * Ty)), DGRAY, B
        Frm.Line (ct.Left - (1 * Tx), ct.Top - (1 * Ty))-(ct.Width + (1 * Tx) + ct.Left, ct.Top + ct.Height + (1 * Ty)), WHITE, B
        Frm.Line (ct.Left - (2 * Tx), ct.Top - (2 * Ty))-(ct.Width + ct.Left + (1 * Tx), ct.Top + ct.Height + (1 * Ty)), GRAY, B
    End If
    If TypeOf ct Is ComboBox Then
        Frm.Line (ct.Left + (1 * Tx), ct.Top + (1 * Ty))-(ct.Width + (0 * Tx) + ct.Left, ct.Top + ct.Height + (0 * Ty)), DGRAY, B
        Frm.Line (ct.Left - (1 * Tx), ct.Top - (1 * Ty))-(ct.Width + (1 * Tx) + ct.Left, ct.Top + ct.Height + (1 * Ty)), WHITE, B
        Frm.Line (ct.Left - (2 * Tx), ct.Top - (2 * Ty))-(ct.Width + ct.Left + (1 * Tx), ct.Top + ct.Height + (1 * Ty)), GRAY, B
    End If
    If TypeOf ct Is Line Then
        ct.Visible = False
        Frm.Line (ct.X1 + (1 * Tx), ct.Y1 + (1 * Ty))-(ct.X2 + (1 * Tx), ct.Y2 + (1 * Ty)), DGRAY
        Frm.Line (ct.X1 + (0 * Tx), ct.Y1 + (0 * Ty))-(ct.X2 + (0 * Tx), ct.Y2 + (0 * Ty)), WHITE
    End If

Next I
Frm.AutoRedraw = False

End Sub

Option Explicit

Type TM_OutlineRec
  Bezeichnung As String * 25
  hat_unter_obj As Integer
  Vaterobj As Long
  Kind As Long
  Vor As Long
  Nach As Long
  Pfad As String * 128
  Ebene As Integer
  Visible As Integer
End Type

Type TM_DBRec
  Bezeichnung As String * 25
  Vater As Long
  Verzeichnis As String * 128
  Code As Integer
End Type

Global GM_Outline() As TM_OutlineRec
Global GM_DB As TM_DBRec

Global Const GCM_INFOFILENAME = "CDINFO.TXT"
Global Const GCM_VERZEICHNIS = "VERZEICHNIS="
Global Const GCM_PROJEKT = "PROJEKT="
Global Const GCM_INFO = "INFO="
Global Const GCM_DEMO = "DEMO="
Global Const GCM_INSTALL = "INSTALL="
Global Const GCM_DBNAME = "SPY.DAT"
Global Const GCM_EINSTELLUNGEN = "Einstellungen"
Global Const GCM_SEPERATOR = ","
' SchaltflΣchen im Cmd_Array
Global Const GCM_CMD_INFO = 0
Global Const GCM_CMD_DEMO = 1
Global Const GCM_CMD_COPY = 2
Global Const GCM_CMD_INSTALL = 3
Global Const GCM_CMD_CODE = 4
Global Const GCM_CMD_HILFE = 5


Global GM_DBAll() As TM_DBRec

Declare Function SendMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
Declare Function GetModuleUsage Lib "KERNEL" (ByVal InstanceID%) As Integer


Global G_CDInfoFile As String

Global G_Control As Control
Global G_EditFile As String

Function ExistDir% (drn$)
  Dim temp$
  On Error Resume Next
  temp$ = Dir$(drn$, 16)
  If Err <> 0 Or temp$ = "" Then
    ExistDir% = False
  Else
    ExistDir% = True
  End If
End Function

Function exists (dn$) As Integer
  Dim temp$
  On Error Resume Next
  temp$ = Dir$(dn$, 32)
  exists = Not (Err <> 0 Or temp$ = "")
End Function

Function FM_LiesDB (ID&)
  Dim fd As Integer
  If ID < 1 Then
    Exit Function
  End If
  fd = FreeFile
  Open GCM_DBNAME For Random As fd Len = Len(GM_DB)
  If ID& * Len(GM_DB) <= LOF(fd) Then
    Get #fd, ID&, GM_DB
    FM_LiesDB = ID&
  Else
    FM_LiesDB = 0
  End If
  Close fd
End Function

Function FM_Max (X, y)
  If X > y Then
    FM_Max = X
  Else
    FM_Max = y
  End If
End Function

Function FM_Min (X, y)
  If X < y Then
    FM_Min = X
  Else
    FM_Min = y
  End If
End Function

' --------------------------------------------------------
' Die Funktion Parse_Zeile liefert aus einer gegebenen
' Zeile die Zeichenkette bis zum ersten Zeichen ch$ zurⁿck
' und reduziert die Zeile auf den nachfolgenden Teil der
' Zeile ▄ber den Parameter z$ wird die Zeile zur Initia-
' lisierung ⁿbergeben. Zum Abrufen der Werte wird ein
' Leerstring als z$ ⁿbergeben
' --------------------------------------------------------
Function FM_ParseZeile$ (z$, ch$)
  Static txt$, Zch$
  Dim tmp$

  If z$ <> "" Then
    ' Zeile initialisieren
    txt$ = z$ + ch$
    Zch$ = ch$
  End If
  If Trim$(txt$) <> "" Then
    ' Zeichenkette bis zum ersten Tabulatorzeichen bestimmen
    tmp$ = Left$(txt$, InStr(txt$, Zch$) - 1)
    ' Zeile auf Teil nach erstem Tabulatorzeichen reduzieren
    txt$ = LTrim$(Mid$(txt$, InStr(txt$, Zch$) + 1))
  End If
  FM_ParseZeile$ = tmp$
End Function

Function FM_SchreibDB ()
  Dim fd As Integer
  Dim pos%
  fd = FreeFile
  Open GCM_DBNAME For Random As fd Len = Len(GM_DB)
  pos% = (LOF(fd) / Len(GM_DB)) + 1
  Put #fd, pos%, GM_DB
  FM_SchreibDB = pos%
  Close fd
End Function

Function FM_Verz$ (Verz$)
  Dim tmp$
  tmp$ = Trim$(Verz$)
  If Right$(tmp$, 1) <> "\" Then
    tmp$ = tmp$ + "\"
  End If
  FM_Verz$ = tmp$
End Function

Sub ListSubDirs (path$, d() As TM_DBRec)
  Const ATTR_DIRECTORY = 16
  Dim position%, Count%, Vater%

  Dim I, dirname

  On Error Resume Next
  If Right$(path$, 1) <> "\" Then path$ = path$ + "\"
  If ExistDir(path$) Then
    position% = 1
    Count% = 1
    dirname = Dir(path, ATTR_DIRECTORY) ' Erster Verzeichnisname

    'Alle Verzeichnisse innerhalb dieses Verzeichnisses in D() speichern
    ReDim d(Count%)
    d(Count%).Verzeichnis$ = path$
    d(Count%).Vater = 0
    PM_GetCDINFO d(Count%)
    Count% = Count% + 1
    Do
      Do While dirname <> ""
        DoEvents
        If dirname <> "." And dirname <> ".." Then
          If (GetAttr(path + dirname) And ATTR_DIRECTORY) = ATTR_DIRECTORY Then
            ReDim Preserve d(Count%)
            d(Count%).Verzeichnis = path + dirname
            d(Count%).Vater = position%
            PM_GetCDINFO d(Count%)
            Count% = Count% + 1
          End If
        End If
        dirname = Dir   ' Get another directory name.
      Loop
      position% = position% + 1
      If position% >= Count% Then Exit Do
      path$ = Trim$(d(position%).Verzeichnis$) + "\"
      dirname = Dir(path, ATTR_DIRECTORY)
    Loop
  End If
End Sub

Sub PM_ChangeCmdState (index%)
  Static old%
  Dim Res&
  If Haupt!Cmd_Array(index%).Enabled Then
    Res& = SendMessage(Haupt!Cmd_Array(index%).hWnd, &H403, -1, 0)
  Else
    Res& = SendMessage(Haupt!Cmd_Array(index%).hWnd, &H403, 0, 0)
  End If
  If old% = index% Then Exit Sub
  Res& = SendMessage(Haupt!Cmd_Array(old%).hWnd, &H403, 0, 0)
  old% = index%
End Sub

Sub PM_ClearDB ()
  Dim fd As Integer
  fd = FreeFile
  Kill GCM_DBNAME
End Sub

Sub PM_EditFile (dn$)
  Dim fd As Integer
  Dim L_LengthOfFile%
  Dim tmp$
  fd = FreeFile
  L_LengthOfFile% = FileLen(dn$)
  tmp$ = Space$(L_LengthOfFile%)
  Open dn$ For Binary As fd Len = L_LengthOfFile%
  Get fd, 1, tmp$
  G_EditFile$ = tmp$
  Close fd
  EditFile.Caption = dn$
  EditFile.Show
End Sub

Sub PM_GenerateDB (Pfad$)
  Dim I%, Res%
  If ExistDir(Pfad$) Then
    PM_ClearDB
    ListSubDirs Pfad$, GM_DBAll()
    For I% = 1 To UBound(GM_DBAll)
      GM_DB = GM_DBAll(I%)
      Res% = FM_SchreibDB()
    Next I%
  End If
End Sub

Sub PM_GetCDINFO (d As TM_DBRec)
  Dim tmp$, fd%, Zeile$, pos%
  tmp$ = Trim$(d.Verzeichnis$)
  If Right$(tmp$, 1) <> "\" Then tmp$ = tmp$ + "\"
  tmp$ = Trim$(tmp$) + "CDINFO.TXT"
  fd = FreeFile
  On Error Resume Next
  Open tmp$ For Input As fd
  If Err <> 0 Then Exit Sub
  If Not EOF(fd) Then
    Line Input #fd, Zeile$
    pos% = InStr(UCase$(Zeile$), GCM_VERZEICHNIS)
    If pos% Then
      d.Bezeichnung$ = Mid$(Zeile$, pos% + Len(GCM_VERZEICHNIS))
    End If
    If Not EOF(fd) Then
      Line Input #fd, Zeile$
      pos% = InStr(UCase$(Zeile$), GCM_PROJEKT)
      If pos% Then
        d.Code = 1
      Else
        d.Code = 0
      End If
    End If
  End If
  Close fd
End Sub

Sub PM_GetChilds (ID&, d())
  Dim fd As Integer
  Dim I%
  fd = FreeFile
  Open GCM_DBNAME For Random As fd Len = Len(GM_DB)
  For I% = 1 To LOF(fd) / Len(GM_DB)
    Get #fd, I%, GM_DB
    If GM_DB.Vater = ID& Then
      d(UBound(d)) = I%
      ReDim Preserve d(UBound(d) + 1)
    End If
  Next I%
  Close fd
End Sub

Sub PM_GetFileInfo (dn$)
  Dim ds As Integer
  Dim pos%
  Dim Zeile$
  Dim Ub%
  ds = FreeFile
  Open dn$ For Input As ds
  Line Input #ds, Zeile$
  pos% = InStr(Zeile$, GCM_VERZEICHNIS)
  If pos% Then ' Verzeichnis
    On Error Resume Next
    Ub% = UBound(GM_Outline)
    On Error GoTo 0
    Ub% = Ub% + 1
    ReDim Preserve GM_Outline(Ub%)
    GM_Outline(Ub%).Bezeichnung = Mid$(Zeile$, pos% + Len(GCM_VERZEICHNIS))
  End If
  If Not EOF(ds) Then
    Line Input #ds, Zeile$
    pos% = InStr(Zeile$, GCM_PROJEKT)
    If pos% Then
      GM_Outline(Ub%).hat_unter_obj = False
    Else
      GM_Outline(Ub%).hat_unter_obj = True
    End If
  Else
    GM_Outline(Ub%).hat_unter_obj = True
  End If
  Close #ds
End Sub

Sub PM_GetParents (ID&, d())
  Dim fd As Integer
  Dim I%
  fd = FreeFile
  Open GCM_DBNAME For Random As fd Len = Len(GM_DB)
  For I% = 1 To LOF(fd) / Len(GM_DB)
    Get #fd, I%, GM_DB
    If GM_DB.Vater = ID& Then
      d(UBound(d)) = I%
      ReDim Preserve d(UBound(d) + 1)
    End If
  Next I%
  Close fd
End Sub

Sub PM_LeseEintrag (index As Long, ByVal ID As Long, Ebene%)
  Dim Vater&
  Dim LM_DB As TM_DBRec
  Dim tmpIndex&
  ReDim d(1)
  Dim cnt%, I%, Res%
  Res% = FM_LiesDB(ID&)
  LM_DB = GM_DB
  If ID > 0 Then
    PM_LeseEintrag index&, LM_DB.Vater&, Ebene%
    PM_GetParents ID&, d()
    For I% = 1 To UBound(d) - 1
      Res% = FM_LiesDB(CLng(d(I%)))
      If Res% <> 0 Then
        Haupt.Outline.AddItem GM_DB.Bezeichnung, index
        Haupt.Outline.ItemData(index) = Res%
        Haupt.Outline.Indent(index) = Ebene%
        If Not GM_DB.Code Then
          Haupt.Outline.PictureType(index&) = 0
        Else
          Haupt.Outline.PictureType(index&) = 2
        End If
        If Haupt.Outline.ItemData(index) = LM_DB.Vater& Then
          tmpIndex& = index&
          Haupt.Outline.Expand(index&) = True
        End If
        index& = index& + 1
      End If
    Next I%

    If tmpIndex& <> 0 Then index& = tmpIndex& + 1
  Else
    Res% = FM_LiesDB(1)
    Ebene% = 1
    If Res% <> 0 Then
      Haupt.Outline.AddItem GM_DB.Bezeichnung, index
      Haupt.Outline.ItemData(index) = Res%
      Haupt.Outline.Indent(index) = Ebene%
      If Not GM_DB.Code Then
        Haupt.Outline.PictureType(index&) = 0
      Else
        Haupt.Outline.PictureType(index&) = 2
      End If
      If Haupt.Outline.ItemData(index) = LM_DB.Vater& Then
        Haupt.Outline.Expand(index&) = True
        tmpIndex& = index&
      End If
      index& = index& + 1
    End If
  End If
  Ebene% = Ebene% + 1
End Sub

Sub PM_Lies (ID&)
  Dim index&
  Dim Ebene%
  index& = 0
  Haupt.Outline.Clear
  PM_LeseEintrag index&, ID&, Ebene%
End Sub

Sub PM_LiesCDInfo (Verzeichnis$)
  Dim fd As Integer
  Dim l&
  Dim L_CDInfoFilename$
  If Right$(Verzeichnis$, 1) <> "\" Then
    L_CDInfoFilename$ = Verzeichnis$ + "\" + GCM_INFOFILENAME
  Else
    L_CDInfoFilename$ = Verzeichnis$ + GCM_INFOFILENAME
  End If
  l& = FileLen(L_CDInfoFilename$)
  G_CDInfoFile$ = Space$(l&)
  fd = FreeFile
  Open L_CDInfoFilename$ For Binary As fd Len = l&
  Get #fd, , G_CDInfoFile$
  Close fd
End Sub

' --------------------------------------------------------
' Liest die ben÷tigten Control-Informationen aus dem
' Initialisierungsfile
' --------------------------------------------------------
' Autor   : NM/ag
' Datum   : 10.2.94
' Version : 1.0
' --------------------------------------------------------
Sub PM_LiesControl (Ctrl As Control)
  Dim L_Ini_Zeile$, Eigenschaft$
  L_Ini_Zeile$ = F_GetPrivatIni("Einstellungen", Ctrl.Tag)
  Eigenschaft$ = FM_ParseZeile$((L_Ini_Zeile$), GCM_SEPERATOR)
  If TypeOf Ctrl Is Label Then
    If Eigenschaft$ = "" Then Exit Sub
    Ctrl.FontName = Eigenschaft$
    Eigenschaft$ = FM_ParseZeile$("", "")
    If Eigenschaft$ = "" Then Exit Sub
    Ctrl.FontSize = Val(Eigenschaft$)
    Eigenschaft$ = FM_ParseZeile$("", "")
    If Eigenschaft$ = "" Then Exit Sub
    Ctrl.FontBold = Val(Eigenschaft$)
    Eigenschaft$ = FM_ParseZeile$("", "")
    If Eigenschaft$ = "" Then Exit Sub
    Ctrl.ForeColor = Val(Eigenschaft$)
    Eigenschaft$ = FM_ParseZeile$("", "")
    If Eigenschaft$ = "" Then Exit Sub
    Ctrl.BackColor = Val(Eigenschaft$)
  Else
    If Eigenschaft$ = "" Then Exit Sub
    Ctrl.FontName = Eigenschaft$
    Eigenschaft$ = FM_ParseZeile$("", "")
    If Eigenschaft$ = "" Then Exit Sub
    Ctrl.FontSize = Val(Eigenschaft$)
    Eigenschaft$ = FM_ParseZeile$("", "")
    If Eigenschaft$ = "" Then Exit Sub
    Ctrl.FontBold = Val(Eigenschaft$)
    Eigenschaft$ = FM_ParseZeile$("", "")
    If Eigenschaft$ = "" Then Exit Sub
    Ctrl.ForeColor = Val(Eigenschaft$)
    Eigenschaft$ = FM_ParseZeile$("", "")
    If Eigenschaft$ = "" Then Exit Sub
    Ctrl.BackColor = Val(Eigenschaft$)
  End If
End Sub

' --------------------------------------------------------
' Liest die ben÷tigten Formular-Informationen aus dem
' Initialisierungsfile
' --------------------------------------------------------
' Autor   : NM/ag
' Datum   : 10.2.94
' Version : 1.0
' --------------------------------------------------------
Sub PM_LiesForm (Frm As Form)
  Dim L_Ini_Zeile$, Eigenschaft$
  L_Ini_Zeile$ = F_GetPrivatIni("Einstellungen", Frm.Tag)
  Eigenschaft$ = FM_ParseZeile$((L_Ini_Zeile$), GCM_SEPERATOR)
  If Eigenschaft$ = "" Then Exit Sub
  Frm.Top = Val(Eigenschaft$)
  Eigenschaft$ = FM_ParseZeile$("", "")
  If Eigenschaft$ = "" Then Exit Sub
  Frm.Left = Val(Eigenschaft$)
  Eigenschaft$ = FM_ParseZeile$("", "")
  If Eigenschaft$ = "" Then Exit Sub
  Frm.Width = Val(Eigenschaft$)
  Eigenschaft$ = FM_ParseZeile$("", "")
  If Eigenschaft$ = "" Then Exit Sub
  Frm.Height = Val(Eigenschaft$)
  Eigenschaft$ = FM_ParseZeile$("", "")
  If Eigenschaft$ = "" Then Exit Sub
  Frm.WindowState = Val(Eigenschaft$)
End Sub

Sub PM_LiesOutline (pos%)
  Dim fd As Integer
  fd = FreeFile
  Open GCM_DBNAME For Random As fd Len = Len(GM_DB)
  Get fd, pos%, GM_DB
  Haupt.Outline.AddItem GM_DB.Bezeichnung
  Haupt.Outline.ItemData(0) = pos%
  Haupt.Outline.Indent(1) = 2
  Close fd
  Haupt.Outline.Refresh
End Sub

Sub PM_ReadCDInfo ()
  Dim Res&
  Dim pos%
  Dim L_CDInfoCommands$
  Dim tmp$
  Dim MakDatei$, HilfeDatei$
  Res& = FM_LiesDB(Val(Haupt!Outline.ItemData(Haupt!Outline.ListIndex)))
  PM_LiesCDInfo Trim$(GM_DB.Verzeichnis$)
  pos% = InStr(UCase$(G_CDInfoFile$), GCM_INFO)
  If pos% <> 0 Then
    Haupt!Lbl_Info.Caption = Mid$(G_CDInfoFile$, pos% + Len(GCM_INFO))
    Haupt!Lbl_Info.Visible = True
    Haupt!Cmd_Array(GCM_CMD_INFO).Enabled = True
    Haupt!Cmd_Array(GCM_CMD_INFO) = True
    L_CDInfoCommands$ = UCase$(Left$(G_CDInfoFile$, pos% - 1))
  Else
    Haupt!Cmd_Array(GCM_CMD_INFO).Enabled = False
    Haupt!Lbl_Info.Visible = False
    Haupt!Lbl_Info.Caption = ""
    Haupt!Cmd_Array(6) = True
    L_CDInfoCommands$ = UCase$(G_CDInfoFile$)
  End If
  pos% = InStr(L_CDInfoCommands$, GCM_DEMO)
  If pos% <> 0 Then
    Haupt!Cmd_Array(GCM_CMD_DEMO).Enabled = True
    tmp$ = Mid$(L_CDInfoCommands$ + Chr$(13), pos% + Len(GCM_DEMO))
    Haupt!Cmd_Array(GCM_CMD_DEMO).Tag = Left$(tmp$, InStr(tmp$, Chr$(13)) - 1)
  Else
    Haupt!Cmd_Array(GCM_CMD_DEMO).Enabled = False
  End If
  pos% = InStr(L_CDInfoCommands$, GCM_PROJEKT)
  If pos% <> 0 Then
    Haupt!Cmd_Array(GCM_CMD_COPY).Enabled = True
  Else
    Haupt!Cmd_Array(GCM_CMD_COPY).Enabled = False
  End If
  tmp$ = FM_Verz$(GM_DB.Verzeichnis$) + "*.MAK"
  MakDatei$ = Dir$(tmp$)
  If MakDatei$ <> "" Then
    Haupt!Cmd_Array(GCM_CMD_CODE).Enabled = True
    Haupt!Cmd_Array(GCM_CMD_CODE).Tag = FM_Verz$(GM_DB.Verzeichnis$)
  Else
    Haupt!Cmd_Array(GCM_CMD_CODE).Enabled = False
  End If
  pos% = InStr(L_CDInfoCommands$, GCM_INSTALL)
  If pos% <> 0 Then
    Haupt!Cmd_Array(GCM_CMD_INSTALL).Enabled = True
    tmp$ = Mid$(L_CDInfoCommands$ + Chr$(13), pos% + Len(GCM_INSTALL))
    Haupt!Cmd_Array(GCM_CMD_INSTALL).Tag = Left$(tmp$, InStr(tmp$, Chr$(13)) - 1)
  Else
    Haupt!Cmd_Array(GCM_CMD_INSTALL).Enabled = False
  End If
  tmp$ = FM_Verz$(GM_DB.Verzeichnis$) + "*.HLP"
  HilfeDatei$ = Dir$(tmp$)
  If HilfeDatei$ <> "" Then
    Haupt!Cmd_Array(GCM_CMD_HILFE).Enabled = True
    Haupt!Cmd_Array(GCM_CMD_HILFE).Tag = "WinHelp " & FM_Verz$(GM_DB.Verzeichnis$) & HilfeDatei$
  Else
    Haupt!Cmd_Array(GCM_CMD_HILFE).Enabled = False
  End If
  PM_ChangeCmdState (0)
End Sub

Sub PM_ReadItems (ByVal Vater&, ByVal ListIndex%, ByVal Ebene%)
  ReDim d(1)
  Dim cnt%, I%, Res%
  PM_GetParents Vater&, d()
  For I% = 1 To UBound(d) - 1
    Res% = FM_LiesDB(CLng(d(I%)))
    If Res% <> 0 Then
      ListIndex% = ListIndex% + 1
      If ListIndex% < Haupt.Outline.ListCount Then
        If Haupt.Outline.List(ListIndex%) = "Hilfs" Then
          Haupt.Outline.List(ListIndex%) = GM_DB.Bezeichnung$
        Else
          Haupt.Outline.AddItem GM_DB.Bezeichnung, ListIndex%
        End If
      Else
        Haupt.Outline.AddItem GM_DB.Bezeichnung, ListIndex%
      End If
      Haupt.Outline.ItemData(ListIndex%) = Res%
      Haupt.Outline.Indent(ListIndex%) = Ebene%
      If GM_DB.Code = 0 Then
        Haupt.Outline.PictureType(ListIndex%) = 0
        ListIndex% = ListIndex% + 1
        Haupt.Outline.AddItem "Hilfs", ListIndex%
        Haupt.Outline.Indent(ListIndex%) = Ebene% + 1
      Else
        Haupt.Outline.PictureType(ListIndex%) = 2
      End If
    End If
  Next I%
End Sub

Sub PM_RefreshAnzeige ()
  Haupt!Lbl_Info.Move 4, 2
  Haupt!Lbl_Info.Height = Haupt!Pic_Anzeige.Height - 4
  Haupt!Lbl_Info.Width = FM_Max(Haupt!Pic_Anzeige.Width - 6, 0)
  Haupt!File1.Move 4, 2
  Haupt!File1.Width = Haupt!Lbl_Info.Width
  Haupt!File1.Height = Haupt!Lbl_Info.Height
  If Haupt!Lbl_Info.Visible Then
    Haupt!Pic_Anzeige.BackColor = Haupt!Lbl_Info.BackColor
  Else
    Haupt!Pic_Anzeige.BackColor = Haupt!File1.BackColor
  End If
End Sub

Sub PM_ScanDirs (Pfad$, Vater&)
  Dim tmp$, Vater_Neu&, totPfad$
  GM_DB.Bezeichnung$ = "Test"
  GM_DB.Vater& = Vater&
  GM_DB.Verzeichnis$ = Pfad$
  Debug.Print Pfad$
  Vater_Neu& = FM_SchreibDB()
  If Right$(Pfad$, 1) <> "\" Then
    totPfad$ = Pfad$ + "\"
  Else
    totPfad$ = Pfad$ + ""
  End If
  tmp$ = Dir$(totPfad$ + "*.*", 16)
  Do While Left$(tmp$, 1) = "."
    tmp$ = Dir$
  Loop
  Do While tmp$ <> ""
    If GetAttr(totPfad$ + tmp$) = 16 Then ' Verzeichnis
      PM_ScanDirs totPfad$ + tmp$, Vater_Neu&
    End If
    tmp$ = Dir$
  Loop
End Sub

' --------------------------------------------------------
' Speichert die ben÷tigten Control-Informationen im
' Initialisierungsfile ab
' --------------------------------------------------------
' Autor   : NM/ag
' Datum   : 10.2.94
' Version : 1.0
' --------------------------------------------------------
Sub PM_SchreibControl (Ctrl As Control)
  Dim L_Ini_Zeile$
  If TypeOf Ctrl Is Label Then
    L_Ini_Zeile$ = Ctrl.FontName & GCM_SEPERATOR
    L_Ini_Zeile$ = L_Ini_Zeile$ & Trim$(Str$(Ctrl.FontSize)) & GCM_SEPERATOR
    L_Ini_Zeile$ = L_Ini_Zeile$ & Ctrl.FontBold & GCM_SEPERATOR
    L_Ini_Zeile$ = L_Ini_Zeile$ & Ctrl.ForeColor & GCM_SEPERATOR
    L_Ini_Zeile$ = L_Ini_Zeile$ & Ctrl.BackColor
  Else
    L_Ini_Zeile$ = Ctrl.FontName & GCM_SEPERATOR
    L_Ini_Zeile$ = L_Ini_Zeile$ & Trim$(Str$(Ctrl.FontSize)) & GCM_SEPERATOR
    L_Ini_Zeile$ = L_Ini_Zeile$ & Ctrl.FontBold & GCM_SEPERATOR
    L_Ini_Zeile$ = L_Ini_Zeile$ & Ctrl.ForeColor & GCM_SEPERATOR
    L_Ini_Zeile$ = L_Ini_Zeile$ & Ctrl.BackColor
  End If
  P_WritePrivatInit GCM_EINSTELLUNGEN, (Ctrl.Tag), L_Ini_Zeile$
End Sub

' --------------------------------------------------------
' Speichert die ben÷tigten Formular-Informationen im
' Initialisierungsfile ab
' --------------------------------------------------------
' Autor   : NM/ag
' Datum   : 10.2.94
' Version : 1.0
' --------------------------------------------------------
Sub PM_SchreibForm (Frm As Form)
  Dim L_Ini_Zeile$, L_tmp_State%
  L_tmp_State% = Frm.WindowState
  Frm.WindowState = 0
  L_Ini_Zeile$ = Frm.Top & GCM_SEPERATOR
  L_Ini_Zeile$ = L_Ini_Zeile$ & Frm.Left & GCM_SEPERATOR
  L_Ini_Zeile$ = L_Ini_Zeile$ & Frm.Width & GCM_SEPERATOR
  L_Ini_Zeile$ = L_Ini_Zeile$ & Frm.Height & GCM_SEPERATOR
  L_Ini_Zeile$ = L_Ini_Zeile$ & L_tmp_State%
  P_WritePrivatInit GCM_EINSTELLUNGEN, (Frm.Tag), L_Ini_Zeile$
End Sub

Sub PM_SeekList (Cntrl As Control, Eintrag$)
  Dim I%
  For I% = 0 To Cntrl.ListCount - 1
    If Cntrl.List(I%) = Eintrag Then
      Cntrl.ListIndex = I%
      Exit For
    End If
  Next I%
End Sub

Sub PM_ShellAndWait (CommandString$)
  Dim ID%
  Dim X%
  ID% = Shell(CommandString$, 1)
  Do
    DoEvents
    Debug.Print Timer
  Loop Until GetModuleUsage(ID%) = 0
End Sub

Sub PM_Show3D (Frm As Form)
' Colors

Const BLACK = &H0&
Const WHITE = &HFFFFFF
Const GRAY = &HC0C0C0
Const DGRAY = &H808080

Dim ct As Control
Dim I As Integer
Dim Tx As Integer
Dim Ty As Integer

Tx = 1
Ty = 1
Frm.AutoRedraw = True

' Zeichne Formular
Frm.BackColor = &HC0C0C0
If Frm.BorderStyle = 0 Or Frm.BorderStyle = 1 Or Frm.BorderStyle = 3 Then
    Frm.DrawWidth = 2
    Frm.Line (0, 0)-(Frm.ScaleWidth, Frm.ScaleHeight), DGRAY, B
    Frm.DrawWidth = 1
    Frm.Line (0, 0)-(Frm.ScaleWidth, Frm.ScaleHeight), WHITE, B
End If

For I = 0 To Frm.Controls.Count - 1
    Set ct = Frm.Controls(I)
    If TypeOf ct Is Shape Then
        ct.Visible = False
        Frm.DrawWidth = 2
        Frm.Line (ct.Left - (0 * Tx), ct.Top - (0 * Ty))-(ct.Width + (1 * Tx) + ct.Left, ct.Top + ct.Height + (0 * Ty)), DGRAY, B
        Frm.DrawWidth = 1
        Frm.Line (ct.Left - (1 * Tx), ct.Top - (1 * Ty))-(ct.Width + (0 * Tx) + ct.Left, ct.Top + ct.Height - (1 * Ty)), WHITE, B
    End If
    If TypeOf ct Is Label Then

        Frm.FontSize = ct.FontSize
        Frm.FontName = ct.FontName
        Frm.FontBold = ct.FontBold
        ct.Visible = False
        Frm.CurrentX = ct.Left + Tx
        Frm.CurrentY = ct.Top + Ty
        Frm.ForeColor = WHITE
        Frm.Print ct.Caption
        Frm.CurrentX = ct.Left
        Frm.CurrentY = ct.Top
        Frm.ForeColor = BLACK
        Frm.Print ct.Caption
        ct.Visible = True
    End If
    If TypeOf ct Is TextBox Then
        Frm.Line (ct.Left + (1 * Tx), ct.Top + (1 * Ty))-(ct.Width + (0 * Tx) + ct.Left, ct.Top + ct.Height + (0 * Ty)), WHITE, B
        Frm.Line (ct.Left - (1 * Tx), ct.Top - (1 * Ty))-(ct.Width + (1 * Tx) + ct.Left, ct.Top + ct.Height + (1 * Ty)), DGRAY, B
        Frm.Line (ct.Left - (2 * Tx), ct.Top - (2 * Ty))-(ct.Width + ct.Left + (1 * Tx), ct.Top + ct.Height + (1 * Ty)), GRAY, B
    End If
    If TypeOf ct Is ListBox Then
        Frm.Line (ct.Left + (1 * Tx), ct.Top + (1 * Ty))-(ct.Width + (0 * Tx) + ct.Left, ct.Top + ct.Height + (0 * Ty)), DGRAY, B
        Frm.Line (ct.Left - (1 * Tx), ct.Top - (1 * Ty))-(ct.Width + (1 * Tx) + ct.Left, ct.Top + ct.Height + (1 * Ty)), WHITE, B
        Frm.Line (ct.Left - (2 * Tx), ct.Top - (2 * Ty))-(ct.Width + ct.Left + (1 * Tx), ct.Top + ct.Height + (1 * Ty)), GRAY, B
    End If
    If TypeOf ct Is ComboBox Then
        Frm.Line (ct.Left + (1 * Tx), ct.Top + (1 * Ty))-(ct.Width + (0 * Tx) + ct.Left, ct.Top + ct.Height + (0 * Ty)), DGRAY, B
        Frm.Line (ct.Left - (1 * Tx), ct.Top - (1 * Ty))-(ct.Width + (1 * Tx) + ct.Left, ct.Top + ct.Height + (1 * Ty)), WHITE, B
        Frm.Line (ct.Left - (2 * Tx), ct.Top - (2 * Ty))-(ct.Width + ct.Left + (1 * Tx), ct.Top + ct.Height + (1 * Ty)), GRAY, B
    End If
    If TypeOf ct Is Line Then
        ct.Visible = False
        Frm.Line (ct.X1 + (1 * Tx), ct.Y1 + (1 * Ty))-(ct.X2 + (1 * Tx), ct.Y2 + (1 * Ty)), DGRAY
        Frm.Line (ct.X1 + (0 * Tx), ct.Y1 + (0 * Ty))-(ct.X2 + (0 * Tx), ct.Y2 + (0 * Ty)), WHITE
    End If

Next I
Frm.AutoRedraw = False

End Sub