*/
Want to see what people are talking about? See the latest forum posts.
*/

View \frmLog.frm

WinDOS Shell 0.1A

Submitted By: Shehbaz
Rating: starstarstarstarstar (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

corner
© 1996-2008 CommunityHeaven LLC. All rights reserved. Reproduction in whole or in part, in any form or medium without express written permission is prohibited.
Violators of this policy may be subject to legal action. Please read our Terms Of Use and Privacy Statement for more information.
North American business development: Nicolai Wadstrom. Publisher: Lars Hagelin.