WinDOS Shell 0.1A
Submitted By:
Shehbaz
Rating:





(
Rate It)
VERSION 5.00
Begin VB.Form frmLog
BackColor = &H00000000&
BorderStyle = 0 'None
Caption = "Form1"
ClientHeight = 9000
ClientLeft = 0
ClientTop = 0
ClientWidth = 12000
LinkTopic = "Form1"
Picture = "frmLog.frx":0000
ScaleHeight = 9000
ScaleWidth = 12000
ShowInTaskbar = 0 'False
StartUpPosition = 2 'CenterScreen
Begin VB.TextBox txtLog
Appearance = 0 'Flat
BackColor = &H00000000&
BeginProperty Font
Name = "Courier New"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFF80&
Height = 6615
Left = 570
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 0
Top = 1830
Width = 10890
End
Begin VB.Label lblUnload
BackStyle = 0 'Transparent
Caption = "Load"
BeginProperty Font
Name = "Xenotron"
Size = 15.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFF80&
Height = 450
Left = 7800
TabIndex = 5
Top = 960
Width = 1170
End
Begin VB.Label lblExit
BackStyle = 0 'Transparent
Caption = "UN"
BeginProperty Font
Name = "Xenotron"
Size = 15.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFF80&
Height = 540
Left = 8265
TabIndex = 4
Top = 570
Width = 840
End
Begin VB.Label lblClear
BackStyle = 0 'Transparent
Caption = "CLEAR"
BeginProperty Font
Name = "Xenotron"
Size = 15.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFF80&
Height = 615
Left = 9465
TabIndex = 3
Top = 735
Width = 1455
End
Begin VB.Label lblRead
BackStyle = 0 'Transparent
Caption = "READ"
BeginProperty Font
Name = "Xenotron"
Size = 15.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFF80&
Height = 615
Left = 6255
TabIndex = 2
Top = 750
Width = 1215
End
Begin VB.Label lblSave
BackStyle = 0 'Transparent
Caption = "SAVE"
BeginProperty Font
Name = "Xenotron"
Size = 15.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFF80&
Height = 615
Left = 4260
TabIndex = 1
Top = 750
Width = 1215
End
End
Attribute VB_Name = "frmLog"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Function encrypt(infile As String) As Boolean
Dim fileno1 As Integer
Dim fileno2 As Integer
Dim outfile As String
Dim xpos As Long
Dim X As Byte
MousePointer = vbHourglass
xpos = 4
outfile = "c:\temp.enc"
fileno1 = 7
Open infile For Binary As fileno1
fileno2 = 8
Open outfile For Binary As fileno2
Put #fileno2, 1, 0
Put #fileno2, 2, 128
Put #fileno2, 3, 0
Put #fileno2, 4, 128
Do While Not EOF(fileno1)
xpos = xpos + 1
Get #fileno1, xpos - 4, X
'MsgBox "Putting " & X & " " & xpos
Put #fileno2, xpos, X + 128
Loop
Close fileno2
Close fileno1
Kill infile
FileCopy outfile, infile
Kill outfile
encrypt = True
MousePointer = vbNormal
End Function
Private Function decrypt(infile As String) As Boolean
On Error GoTo err3
Dim fileno1 As Integer
Dim fileno2 As Integer
Dim outfile As String
Dim xpos As Long
Dim X As Byte
Dim t(3) As Byte
MousePointer = vbHourglass
xpos = 4
outfile = "c:\temp.enc"
fileno1 = 5
Open infile For Binary As fileno1
fileno2 = 6
Get #fileno1, 1, t(0)
Get #fileno1, 2, t(1)
Get #fileno1, 3, t(2)
Get #fileno1, 4, t(3)
If (t(0) = 0 And t(1) = 128 And t(2) = 0 And t(3) = 128) Then
Open outfile For Binary As fileno2
Do While Not EOF(fileno1)
xpos = xpos + 1
Get #fileno1, xpos, X
If (X - 128) >= 0 Then
'MsgBox "Getting " & X - 128 & " " & xpos
Put #fileno2, xpos - 4, X - 128
End If
Loop
Close fileno2
Close fileno1
decrypt = True
Else
decrypt = False
End If
If decrypt Then
Kill infile
FileCopy outfile, infile
Kill outfile
End If
err3:
MousePointer = vbNormal
Close fileno2
Close fileno1
End Function
Private Sub Form_Load()
txtLog.Text = Date & " " & Time & vbCrLf
End Sub
Private Sub lblClear_Click()
txtLog.Text = Date & " " & Time & vbCrLf
End Sub
Private Sub lblExit_Click()
Unload Me
End Sub
Private Sub lblRead_Click()
Dim filepath As String
filepath = App.Path & "\logfile.txt"
Dim f As String
txtLog.Text = ""
decrypt (filepath)
Open filepath For Input As #2
Do Until EOF(2)
Line Input #2, f
txtLog.Text = txtLog.Text & f & vbCrLf
Loop
Close #2
encrypt (filepath)
End Sub
Private Sub lblSave_Click()
Dim filepath As String
filepath = App.Path & "\logfile.txt"
decrypt (filepath)
Open filepath For Append As #1
Print #1, " "
Print #1, txtLog.Text
Print #1, " "
Close #1
encrypt (filepath)
End Sub
Private Sub lblUnload_Click()
Unload Me
End Sub