home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Troubleshooting Netware Systems
/
CSTRIAL0196.BIN
/
attach
/
msj
/
v10n10
/
vb40.exe
/
WCIMR.EXE
/
WCIMREAD.FRM
< prev
next >
Wrap
Text File
|
1995-10-01
|
31KB
|
945 lines
VERSION 4.00
Begin VB.Form MainFrm
Caption = "WinCIM Message Reader"
ClientHeight = 5895
ClientLeft = 420
ClientTop = 780
ClientWidth = 8910
Height = 6630
Icon = "WCIMRead.frx":0000
Left = 360
LinkTopic = "Form1"
ScaleHeight = 5895
ScaleWidth = 8910
Top = 105
Width = 9030
Begin VB.PictureBox picTabs
Appearance = 0 'Flat
BackColor = &H00C0C0C0&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 2415
Index = 1
Left = 480
ScaleHeight = 2415
ScaleWidth = 7935
TabIndex = 5
Top = 3000
Width = 7935
Begin VB.CommandButton btnClearSearch
Caption = "&Clear Search"
Height = 375
Left = 6000
TabIndex = 9
Top = 720
Width = 1335
End
Begin VB.CommandButton btnStopSearch
Caption = "Sto&p"
Enabled = 0 'False
Height = 375
Left = 6000
TabIndex = 8
Top = 1200
Width = 1335
End
Begin VB.CommandButton btnFindNow
Caption = "F&ind Now"
Height = 375
Left = 6000
TabIndex = 7
Top = 240
Width = 1335
End
Begin TabDlg.SSTab tabSearch
Height = 2415
Left = 0
TabIndex = 6
TabStop = 0 'False
Top = 0
Width = 5775
_Version = 65536
_ExtentX = 10186
_ExtentY = 4260
_StockProps = 15
Caption = "User ID"
BeginProperty Font {FB8F0823-0164-101B-84ED-08002B2EC713}
name = "Arial"
charset = 0
weight = 400
size = 8.25
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
TabsPerRow = 3
Tab = 0
TabOrientation = 3
Tabs = 3
Style = 1
TabMaxWidth = 0
TabHeight = 529
TabCaption(0) = "User ID"
Tab(0).ControlCount= 1
Tab(0).ControlEnabled= -1 'True
Tab(0).Control(0)= "Frame1"
TabCaption(1) = "Date"
Tab(1).ControlCount= 1
Tab(1).ControlEnabled= 0 'False
Tab(1).Control(0)= "Frame3"
TabCaption(2) = "Text"
Tab(2).ControlCount= 1
Tab(2).ControlEnabled= 0 'False
Tab(2).Control(0)= "Frame2"
Begin VB.Frame Frame2
Appearance = 0 'Flat
BackColor = &H00C0C0C0&
ForeColor = &H00C0C0C0&
Height = 2175
Left = -74880
TabIndex = 31
Top = 120
Width = 5175
Begin VB.TextBox edSearch
Height = 285
Left = 1320
TabIndex = 35
Top = 360
Width = 3375
End
Begin VB.CheckBox Check1
Caption = "Case Sensitive"
Height = 255
Left = 1320
TabIndex = 34
Top = 720
Width = 1695
End
Begin VB.OptionButton Option3
Caption = "Subject Only"
Height = 255
Index = 0
Left = 1320
TabIndex = 33
Top = 1440
Width = 1335
End
Begin VB.OptionButton Option3
Caption = "Message Text"
Height = 255
Index = 1
Left = 1320
TabIndex = 32
Top = 1200
Value = -1 'True
Width = 1335
End
Begin VB.Label Label3
Caption = "Search For:"
Height = 255
Left = 240
TabIndex = 36
Top = 360
Width = 855
End
End
Begin VB.Frame Frame3
Appearance = 0 'Flat
BackColor = &H00C0C0C0&
Enabled = 0 'False
ForeColor = &H80000008&
Height = 2175
Left = -74880
TabIndex = 18
Top = 120
Width = 5175
Begin VB.TextBox Text4
Height = 285
Left = 2640
TabIndex = 26
Top = 600
Width = 735
End
Begin VB.OptionButton optDate
Caption = "After:"
Height = 255
Index = 1
Left = 1560
TabIndex = 25
Top = 600
Width = 735
End
Begin VB.OptionButton optDate
Caption = "Before:"
Height = 255
Index = 0
Left = 1560
TabIndex = 24
Top = 240
Value = -1 'True
Width = 855
End
Begin VB.OptionButton optDate
Caption = "During the previous"
Height = 255
Index = 3
Left = 360
TabIndex = 23
Top = 1440
Width = 1695
End
Begin VB.OptionButton optDate
Caption = "During the previous"
Height = 255
Index = 4
Left = 360
TabIndex = 22
Top = 1080
Width = 1695
End
Begin VB.TextBox Text7
Height = 285
Left = 2160
TabIndex = 21
Top = 1080
Width = 1095
End
Begin VB.TextBox Text8
Height = 285
Left = 2160
TabIndex = 20
Top = 1440
Width = 1095
End
Begin VB.TextBox Text9
Height = 285
Left = 2640
TabIndex = 19
Top = 240
Width = 735
End
Begin VB.Label lblDate2
Caption = "days."
Height = 255
Index = 1
Left = 3360
TabIndex = 30
Top = 1440
Width = 615
End
Begin VB.Label lblDate2
Caption = "months."
Height = 255
Index = 0
Left = 3360
TabIndex = 29
Top = 1080
Width = 615
End
Begin Spin.SpinButton SpinButton1
Height = 255
Left = 3480
TabIndex = 28
Top = 240
Width = 135
_Version = 65536
_ExtentX = 238
_ExtentY = 450
_StockProps = 73
End
Begin Spin.SpinButton SpinButton2
Height = 255
Left = 3480
TabIndex = 27
Top = 600
Width = 135
_Version = 65536
_ExtentX = 238
_ExtentY = 450
_StockProps = 73
End
End
Begin VB.Frame Frame1
Appearance = 0 'Flat
BackColor = &H00C0C0C0&
ForeColor = &H80000008&
Height = 2175
Left = 120
TabIndex = 10
Top = 120
Width = 5175
Begin VB.PictureBox Picture1
Appearance = 0 'Flat
BackColor = &H00C0C0C0&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 735
Left = 3360
ScaleHeight = 735
ScaleWidth = 1455
TabIndex = 39
Top = 240
Width = 1455
Begin VB.OptionButton Option2
Height = 195
Index = 1
Left = 0
TabIndex = 41
Top = 360
Width = 375
End
Begin VB.OptionButton Option2
Height = 195
Index = 0
Left = 0
TabIndex = 40
Top = 0
Value = -1 'True
Width = 375
End
End
Begin VB.TextBox EdtSrchName
Height = 285
Left = 1320
TabIndex = 15
Top = 240
Width = 1935
End
Begin VB.TextBox EdtSrchUID
Height = 285
Left = 1320
TabIndex = 14
Top = 600
Width = 1935
End
Begin VB.OptionButton Option1
Caption = "Either"
Height = 255
Index = 2
Left = 1200
TabIndex = 13
Top = 1440
Value = -1 'True
Width = 1695
End
Begin VB.OptionButton Option1
Caption = "Sent To"
Height = 255
Index = 1
Left = 1200
TabIndex = 12
Top = 1200
Width = 1695
End
Begin VB.OptionButton Option1
Caption = "Sent By"
Height = 255
Index = 0
Left = 1200
TabIndex = 11
Top = 960
Width = 1695
End
Begin VB.Label Label4
Caption = "Name:"
Height = 255
Left = 480
TabIndex = 17
Top = 240
Width = 735
End
Begin VB.Label Label5
Caption = "User ID:"
Height = 255
Left = 480
TabIndex = 16
Top = 600
Width = 735
End
End
End
End
Begin VB.PictureBox picTabs
Appearance = 0 'Flat
BackColor = &H00C0C0C0&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 2175
Index = 0
Left = 240
ScaleHeight = 2175
ScaleWidth = 8535
TabIndex = 3
Top = 3000
Width = 8535
Begin VB.TextBox EdtMsgText
Height = 2175
Left = 0
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 4
Top = 0
Width = 8095
End
End
Begin MSMAPI.MAPIMessages MAPIMessages1
Left = 8520
Top = 5040
_Version = 65536
_ExtentX = 741
_ExtentY = 741
_StockProps = 0
End
Begin MSMAPI.MAPISession MAPISession1
Left = 8520
Top = 4800
_Version = 65536
_ExtentX = 741
_ExtentY = 741
_StockProps = 0
End
Begin ComctlLib.ProgressBar ProgBar
Height = 255
Left = 3360
TabIndex = 38
Top = 2400
Width = 5415
_Version = 65536
_ExtentX = 9551
_ExtentY = 450
_StockProps = 73
End
Begin ComctlLib.ListView lvwThreads
Height = 2295
Left = 3360
TabIndex = 37
Top = 120
Width = 5415
_Version = 65536
_ExtentX = 9551
_ExtentY = 4048
_StockProps = 77
BackColor = 16777215
BorderStyle = 1
Arrange = 3
HideSelection = 0 'False
Icons = "imlFolders"
LabelEdit = 1
MultiSelect = -1 'True
SmallIcons = "imlFolders"
Sorted = -1 'True
SortKey = 1
View = 3
NumItems = 5
i1 = "WCIMRead.frx":030A
i2 = "WCIMRead.frx":03BE
i3 = "WCIMRead.frx":0493
i4 = "WCIMRead.frx":0568
i5 = "WCIMRead.frx":0645
End
Begin ComctlLib.TabStrip tabMain
Height = 3015
Left = 120
TabIndex = 2
Top = 2640
Width = 8775
_Version = 65536
_ExtentX = 15478
_ExtentY = 5318
_StockProps = 68
ImageList = ""
ShowTips = -1 'True
NumTabs = 2
i1 = "WCIMRead.frx":0716
i2 = "WCIMRead.frx":0847
End
Begin ComctlLib.TreeView tvwFolders
Height = 2295
Left = 120
TabIndex = 1
Top = 120
Width = 3255
_Version = 65536
_ExtentX = 5741
_ExtentY = 4048
_StockProps = 68
BorderStyle = 1
ImageList = "imlFolders"
Indentation = 30
LineStyle = 1
PathSeparator = "\"
Sorted = -1 'True
Style = 7
End
Begin ComctlLib.StatusBar StatBar
Align = 2 'Align Bottom
Height = 255
Left = 0
TabIndex = 0
Top = 5640
Width = 8910
_Version = 65536
_ExtentX = 15716
_ExtentY = 450
_StockProps = 68
AlignSet = -1 'True
SimpleText = ""
i1 = "WCIMRead.frx":0978
End
Begin ComctlLib.ImageList imlFolders
Left = 8040
Top = 5160
_Version = 65536
_ExtentX = 1296
_ExtentY = 873
_StockProps = 1
ImageWidth = 18
ImageHeight = 18
NumImages = 8
i1 = "WCIMRead.frx":0A45
i2 = "WCIMRead.frx":10A4
i3 = "WCIMRead.frx":1703
i4 = "WCIMRead.frx":1D62
i5 = "WCIMRead.frx":23C1
i6 = "WCIMRead.frx":2A20
i7 = "WCIMRead.frx":2ADF
i8 = "WCIMRead.frx":2B9E
End
Begin MSComDlg.CommonDialog ComDlg
Left = 7680
Top = 5160
_Version = 65536
_ExtentX = 847
_ExtentY = 847
_StockProps = 0
DialogTitle = "Save Thread As..."
End
Begin VB.Menu Mnu_File
Caption = "File"
Begin VB.Menu Mnu_SaveToFile
Caption = "&Save To File..."
End
Begin VB.Menu Mnu_SaveAllThreads
Caption = "Save &All Threads..."
End
Begin VB.Menu Mnu_Print
Caption = "&Print..."
Enabled = 0 'False
End
Begin VB.Menu Mnu_Options
Caption = "&Options..."
End
Begin VB.Menu Mnu_FwdMAPI
Caption = "&Forward MAPI message"
End
Begin VB.Menu Mnu_Sep0
Caption = "-"
End
Begin VB.Menu Mnu_FileExit
Caption = "E&xit"
End
End
Begin VB.Menu Mnu_Folders
Caption = "Folders"
Begin VB.Menu Mnu_Expand
Caption = "&Expand folder tree"
End
Begin VB.Menu Btn_Collapse
Caption = "&Collapse folder tree"
End
Begin VB.Menu Mnu_RefreshFld
Caption = "&Refresh folder tree"
End
End
Begin VB.Menu Mnu_Threads
Caption = "Threads"
Begin VB.Menu Mnu_ViewCurr
Caption = "View &Current"
End
Begin VB.Menu Mnu_ViewNext
Caption = "View &Next"
End
Begin VB.Menu Mnu_ViewPrev
Caption = "View &Previous"
End
Begin VB.Menu Mnu_Sep1
Caption = "-"
End
Begin VB.Menu Mnu_BeginSearch
Caption = "Begin Search"
End
Begin VB.Menu Mnu_StopSearch
Caption = "Stop Search"
End
Begin VB.Menu Mnu_ClearSearch
Caption = "Clear Search"
End
Begin VB.Menu Mnu_Sep2
Caption = "-"
End
Begin VB.Menu Mnu_SortTitle
Caption = "Sort by &Title"
End
Begin VB.Menu Mnu_SortDateDown
Caption = "Sort by &Date (Newest First)"
End
Begin VB.Menu Mnu_SortDateUp
Caption = "Sort by Date (&Oldest First)"
End
Begin VB.Menu Mnu_SortType
Caption = "Sort by T&ype"
End
End
End
Attribute VB_Name = "MainFrm"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Private Sub btnClearSearch_Click()
' When clicked, this button returns all threads to the thread list
ResetThreadList
End Sub
Private Sub btnFindNow_Click()
btnStopSearch.Enabled = True
btnFindNow.Enabled = False
gStopSearch = 0
Select Case tabSearch.Tab
Case 0 ' UserID search
a$ = FindByUID()
Case 1 ' Date search
a$ = FindByDate()
Case 2 ' Text search
a$ = FindStringInFolder(edSearch.TEXT)
End Select
btnFindNow.Enabled = True
btnStopSearch.Enabled = False
End Sub
Private Sub btnStopSearch_Click()
gStopSearch = 1
End Sub
Private Sub Form_Load()
' When the form first loads, we should immediately fill
' up the folders list based on the CABINET.DAT file.
'
' The base node is key="kyCIS"
'
' Other nodes have
' key = "k000" (000 = folder num, the index into the gFolderList array)
' tag = "FOLDERxx.xxx" (8.3 dir name)
Dim F As Folder
Dim topNode As Node
Dim X As Node
'Get the WinCim path. If non-existent, create it
' in the registry!
WCimDir = GetWCIMPathReg()
If (Len(WCimDir) = 0) Then
FrmOptions.Show 1
End If
WCimBase = GetWCIMPathReg()
If (Len(WCimBase) = 0) Then
End
End If
WCimDir = WCimBase & "\FCABINET"
' Turn off the picTabs!
picTabs(0).Visible = True
picTabs(1).Visible = False
gNumFolders = 0
ReDim Preserve gFolderList(20)
' Get file name.
FName$ = WCimDir & "\CABINET\CABINET.DAT"
FNum = FreeFile()
' Add the root node to the folder list
Set topNode = tvwFolders.Nodes.Add(, , "kyCIS", "CompuServe", picFolder, picFolder)
topNode.Tag = "kyCIS"
topNode.Sorted = True
' Open the CABINET.DAT file
Open FName$ For Binary Access Read Lock Read As #FNum
FStart = 21
Do While Not EOF(FNum)
gNumFolders = gNumFolders + 1
If (gNumFolders > UBound(gFolderList)) Then
ReDim Preserve gFolderList(10 + UBound(gFolderList))
End If
Get #FNum, FStart, gFolderList(gNumFolders)
' Trim the folder name and path - make path 8.3
gFolderList(gNumFolders).FName = ZTrim(gFolderList(gNumFolders).FName)
gFolderList(gNumFolders).FPath = ZTrim(gFolderList(gNumFolders).FPath)
If Len(Trim(gFolderList(gNumFolders).FName)) = 0 Then Exit Do
' Don't convert "GENERAL", the all-purpose folder, to 8.3
If (StrComp(gFolderList(gNumFolders).FPath, "GENERAL ") <> 0) Then
Eight = Left$(gFolderList(gNumFolders).FPath, 8)
Three = Right$(gFolderList(gNumFolders).FPath, 3)
FoldName = Eight & "." & Three
Else
FoldName = "GENERAL"
End If
NodeKey = "k" & Format(gNumFolders, "0")
'Set x = tvwFolders.Nodes.Add("kyCIS", 4, gFolderList(gNumFolders).FName, 1, picFolder, picFolder, 1, NodeKey, , FoldName)
Set X = tvwFolders.Nodes.Add("kyCIS", tvwChild, NodeKey, gFolderList(gNumFolders).FName, picFolder, picFolder)
X.Tag = FoldName
X.Sorted = True
FStart = FStart + 30
Loop
Close #FNum
' Now add in-basket and out-basket, and you're done.
ReDim Preserve gFolderList(2 + UBound(gFolderList))
gNumFolders = gNumFolders + 1
gFolderList(gNumFolders).FName = "In Basket"
gFolderList(gNumFolders).FPath = "BASKET.IN"
NodeKey = "k" & Format(gNumFolders, "0")
Set X = tvwFolders.Nodes.Add("kyCIS", tvwChild, NodeKey, gFolderList(gNumFolders).FName, picFolder, picFolder)
X.Tag = "BASKET.IN"
X.Sorted = True
gNumFolders = gNumFolders + 1
gFolderList(gNumFolders).FName = "Out Basket"
gFolderList(gNumFolders).FPath = "BASKET.OUT"
NodeKey = "k" & Format(gNumFolders, "0")
Set X = tvwFolders.Nodes.Add("kyCIS", tvwChild, NodeKey, gFolderList(gNumFolders).FName, picFolder, picFolder)
X.Tag = "BASKET.OUT"
X.Sorted = True
' You have to set Sorted=True AFTER all children are added!
topNode.Sorted = True
End Sub
Private Sub lvwThreads_ColumnClick(ByVal ColumnHeader As ColumnHeader)
' When a ColumnHeader object is clicked, the ListView control is
' sorted by the subitems of that column.
' Set the SortKey to the Index of the ColumnHeader - 1
lvwThreads.SortKey = ColumnHeader.Index - 1
' Set Sorted to True to sort the list.
lvwThreads.Sorted = True
End Sub
Private Sub Mnu_FileExit_Click()
' End the program
End
End Sub
Private Sub Mnu_Options_Click()
FrmOptions.Show 1
End Sub
Private Sub Mnu_RefreshFld_Click()
tvwFolders.Refresh
End Sub
Private Sub Mnu_SaveAllThreads_Click()
' Save ALL threads in this folder to file, given their appropriate names
Dim ThrdMsg As ForumThdMsg
Dim FNum As Integer
Dim ThdNum As Integer
ProgBar.MIN = 0
ProgBar.MAX = gNumThreads
' Get the current folder
sss = gCurFolder.FPath
sss = gCurFolder.FName
For ThdNum = 1 To gNumThreads
ProgBar.Value = ThdNum
DoEvents
Select Case msgtype(ThdNum) 'gThreadList(ThdNum).ComHdr.RecType
Case MT_UNDEF
Strg$ = ProcessUndef(ThdNum)
Case MT_EMAIL
Strg$ = ProcessEMail(ThdNum)
Case MT_FORMSG
Strg$ = ProcessMsg(ThdNum)
Case MT_FORTHD
Strg$ = ProcessThread(ThdNum)
Case MT_IPLEX
Strg$ = ProcessIPlex(ThdNum)
Case MT_DISP
Strg$ = ProcessDisp(ThdNum)
Case MT_ENS
Strg$ = ProcessNews(ThdNum)
End Select
' Now save Strg$ to the filename for thread ThdNum
' Replace every possible bad char with LFN-friendly
' ones
Entry$ = gThreadList(ThdNum).ComPStr.Subject.SData
Entry$ = StrReplace(Entry$, """", "'")
Entry$ = StrReplace(Entry$, "/", "-")
Entry$ = StrReplace(Entry$, "\", "-")
Entry$ = StrReplace(Entry$, "?", " ")
Entry$ = StrReplace(Entry$, ".", "-")
Entry$ = StrReplace(Entry$, "*", "-")
Entry$ = StrReplace(Entry$, ":", "-")
Entry$ = StrReplace(Entry$, ">", "-")
Entry$ = StrReplace(Entry$, "<", "-")
Entry$ = StrReplace(Entry$, "|", "-")
FNum = FreeFile
Open Entry$ For Binary Access Write As #FNum
Put #FNum, , Strg$
Close #FNum
Next ThdNum
End Sub
Private Sub Mnu_SaveToFile_Click()
' When a user chooses to save to a file, we should determine what
' they want saved - the current thread, or message. We should then
' make an appropriate long file name, bring up the save box, and
' dump the right text to it.
Set sel = lvwThreads.SelectedItem
Entry$ = sel
Entry$ = StrReplace(Entry$, """", "'")
ComDlg.filename = Entry$
ComDlg.Action = 2
FNum = FreeFile
Open ComDlg.filename For Binary Access Write As #FNum
Put #FNum, , EdtMsgText.TEXT
Close #FNum
End Sub
Private Sub Mnu_SortDateDown_Click()
lvwThreads.SortKey = 1
lvwThreads.SortOrder = lvwDescending
lvwThreads.Sorted = True
End Sub
Private Sub Mnu_SortDateUp_Click()
lvwThreads.SortKey = 1
lvwThreads.SortOrder = lvwAscending
lvwThreads.Sorted = True
End Sub
Private Sub Mnu_SortTitle_Click()
lvwThreads.SortKey = 0
lvwThreads.Sorted = True
End Sub
Private Sub Mnu_SortType_Click()
lvwThreads.SortKey = 2
lvwThreads.Sorted = True
End Sub
Private Sub tabMain_Click()
Dim a As Integer
a = tabMain.SelectedItem.Index
If picTabs(a - 1).Visible = False Then
For N = 1 To tabMain.Tabs.count
picTabs(N - 1).Visible = False
Next N
picTabs(a - 1).Visible = True
End If
End Sub
Private Sub tvwFolders_DblClick()
' When the folders tree is double clicked, it should
' fill the threads list in with the folder's contents
Set sel = tvwFolders.SelectedItem
FillThreadList (sel.Tag) ' sel.Tag is the folder dir name
' lvwThreads.Selected = lvwThreads.ListItems.Items(1)
End Sub
Private Sub lvwThreads_DblClick()
' When a node in the threads list is double-clicked,
' it should fill the View edit in with the appropriate
' text - either the full thread or individual message
' text.
Dim ThdNum As Integer
Dim Strg$
Dim sel As Variant
On Error Resume Next
Set sel = lvwThreads.SelectedItem
Entry$ = sel
' if you've dblclicked without selection
If Err.Number <> 0 Then Exit Sub
' This always displays the first message with the
' particular name. Change to sel.Index or something?
ThdNum = sel.SubItems(4)
' ThdNum = FindThread(Entry$) ' Mid$(Entry$, 5, Len(Entry$) - 4))
If ThdNum = 0 Then Exit Sub
EdtMsgText.TEXT = ""
DoEvents
Select Case msgtype(ThdNum) 'gThreadList(ThdNum).ComHdr.RecType
Case MT_UNDEF
Strg$ = ProcessUndef(ThdNum)
Case MT_EMAIL
Strg$ = ProcessEMail(ThdNum)
Case MT_FORMSG
Strg$ = ProcessMsg(ThdNum)
Case MT_FORTHD
Strg$ = ProcessThread(ThdNum)
Case MT_IPLEX
Strg$ = ProcessIPlex(ThdNum)
Case MT_DISP
Strg$ = ProcessDisp(ThdNum)
Case MT_ENS
Strg$ = ProcessNews(ThdNum)
Case Else
Exit Sub
End Select
EdtMsgText.TEXT = Strg$
End Sub
Private Sub tvwFolders_Expand(ByVal Node As Node)
Node.Sorted = True
End Sub
