' #=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#
' #  ABOUT                # _ #   # X #
' #=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#
' #                                   #
' #   ProjectName -- VirtualBuffer    #
' #   Version     -- 1.0              #
' #   FileName    -- mdlMain.bas      #
' #   Date        -- 30.08.2005 [Âò]  #
' #   Author      -- SyavX            #
' #   Company     -- Exterminal Inc.  #
' #                                   #
' #=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#

#Compile Exe

Option Explicit

' ============
' # Includes #

'#Resource "res.pbr"

#If Not %Def(%WINAPI)
    #Include "WIN32API.INC"
#EndIf
' # Includes #
' ============

' =============
' # Constants #
$AppName    = "VirtualBuffer"
%AppMajor   = 1
%AppMinor   = 0
%AppBuild   = 0

%frmMain    = 1
%txtText    = 2
%cmdExit    = 3
%cmdLog     = 4
%lblInfo    = 100

%Ctrls_Num  = 4 ' êîëè÷åñòâî êîíòðîëîâ äëÿ subclassing'à


%HK_ALT     = &H1
%HK_CONTROL = &H2
%HK_SHIFT   = &H4

%Buff_Num   = 10 ' &#234;&#238;&#235;&#232;&#247;&#229;&#241;&#242;&#226;&#238; &#226;&#232;&#240;&#242;&#243;&#224;&#235;&#252;&#237;&#251;&#245; &#225;&#243;&#244;&#229;&#240;&#238;&#226; &#238;&#225;&#236;&#229;&#237;&#224; (1 <= %Buff_Num <= 10)
' # Constants #
' =============

' ================
' # Declarations #

' # Variables #
Global PrevProc() As Long
Global hDlg As Long
Global hText As Long
Global hExit As Long
Global hLog As Long
Global bLog As Byte

Global hBuffer() As Dword   ' &#236;&#224;&#241;&#241;&#232;&#226; &#228;&#229;&#241;&#234;&#240;&#232;&#239;&#242;&#238;&#240;&#238;&#226; &#226;&#232;&#240;&#242;&#243;&#224;&#235;&#252;&#237;&#251;&#245; &#225;&#243;&#244;&#229;&#240;&#238;&#226;

' # Functions / Subs #
Declare Sub CopyToBuffer(ByVal id As Long)
Declare Sub PasteFromBuffer(ByVal id As Long)
Declare Sub DeleteFromBuffer(ByVal id As Long)
Declare Sub ClearBuffer()
Declare Sub ClearClipboard()

Declare Sub CopyToBufferEx(ByVal id As Long)
Declare Sub VirtualKey(VK_Key1 As Long, Optional ByVal VK_Key2 As Long, Optional ByVal VK_Key3 As Long)

Declare Sub HookWnd(ByVal id As Byte)
Declare Sub UnHookWnd(ByVal id As Byte)
Declare Sub CreateTimer(ByVal hWnd As Long, ByVal Interval As Long, ByVal id As Byte)
Declare Sub DeleteTimer(ByVal hWnd As Long, ByVal id As Byte)

Declare Sub TimerProc01(ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long)

Declare Function ShowMAIN(ByVal hParent As Long) As Long
Declare CallBack Function frmMain_Proc()

Declare Function frmMain_CallBack(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function txtText_CallBack(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function cmdExit_CallBack(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function cmdLog_CallBack(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
' # Declarations #
' ================

' ==============
' # Sub_Main() #
Function WinMain(ByVal hInstance As Long, ByVal hPrevInst As Long, ByVal lpszCmdLine As Asciiz Ptr, ByVal nCmdShow As Long) As Long

    Call ShowMAIN(%HWND_DESKTOP)
End Function
' # Sub_Main() #
' ==============

' ===========
' # Dialogs #
Function ShowMAIN(ByVal hParent As Long) As Long
    Local lRslt As Long

    ialog New Pixels, hParent, $AppName & " v" & Format$(%AppMajor) & "." & Format$(%AppMinor) & " build " & Format$(%AppBuild, "00", _
                250, 200, 300, 200, _
                %WS_POPUP Or %WS_BORDER Or %WS_DLGFRAME Or %WS_CAPTION Or %WS_SYSMENU Or _
                %WS_MINIMIZEBOX Or %WS_CLIPSIBLINGS Or %WS_VISIBLE Or _
                %DS_MODALFRAME Or %DS_3DLOOK Or %DS_NOFAILCREATE Or %DS_SETFONT Or %DS_CENTER, _
                %WS_EX_WINDOWEDGE Or %WS_EX_CONTROLPARENT Or %WS_EX_LEFT Or %WS_EX_LTRREADING, _
                To hDlg

    Control Add TextBox, hDlg, %txtText, "Text111" & $CrLf & "Text22" & $CrLf & "Text3", _
                5, 5, 200, 90, _
                %WS_CHILD Or %WS_VISIBLE Or %WS_TABSTOP Or %WS_VSCROLL Or %ES_LEFT Or %ES_WANTRETURN Or _
                %ES_MULTILINE Or %ES_AUTOHSCROLL, %WS_EX_CLIENTEDGE Or %WS_EX_LEFT Or _
                %WS_EX_LTRREADING Or %WS_EX_RIGHTSCROLLBAR

    Control Add Label, hDlg, %lblInfo, "Info...", _
                5, 100, 200, 60, _
                %WS_CHILD Or %WS_VISIBLE Or %SS_LEFT, %WS_EX_TRANSPARENT Or _
                %WS_EX_LEFT Or %WS_EX_LTRREADING

    Control Add Button, hDlg, %cmdExit, "Exit", _
                230, 170, 65, 25, _
                %WS_CHILD Or %WS_VISIBLE Or %WS_TABSTOP Or %BS_TEXT Or %BS_PUSHBUTTON _
                Or %BS_CENTER Or %BS_VCENTER, %WS_EX_TRANSPARENT Or %WS_EX_LEFT Or _
                %WS_EX_LTRREADING

    Control Add Button, hDlg, %cmdLog, "Start", _
                230, 5, 65, 25, _
                %WS_CHILD Or %WS_VISIBLE Or %WS_TABSTOP Or %BS_TEXT Or %BS_PUSHBUTTON _
                Or %BS_CENTER Or %BS_VCENTER, %WS_EX_TRANSPARENT Or %WS_EX_LEFT Or _
                %WS_EX_LTRREADING

    Control Handle hDlg, %txtText To hText
    Control Handle hDlg, %cmdExit To hExit
    Control Handle hDlg, %cmdLog To hLog

    ialog Show Modal hDlg, Call frmMain_Proc To lRslt

    Function = lRslt
End Function
' # Dialogs #
' ===========

' =============
' # CallBacks #
CallBack Function frmMain_Proc()
    Select Case CbMsg
        Case %WM_INITDIALOG
            ReDim PrevProc(0 To %Ctrls_Num)
            Call HookWnd(%frmMain)
            Call HookWnd(%txtText)
            Call HookWnd(%cmdExit)
            Call HookWnd(%cmdLog)

          Local i As Byte

            ReDim hBuffer(0 To %Buff_Num - 1)
            For i = 0 To %Buff_Num - 1
                Call RegisterHotKey(hDlg, 10 + i, %HK_CONTROL, %VK_NUMPAD0 + i)
                Call RegisterHotKey(hDlg, 20 + i, %HK_ALT, %VK_NUMPAD0 + i)
                Call RegisterHotKey(hDlg, 30 + i, %HK_CONTROL Or %HK_ALT, %VK_NUMPAD0 + i)

                hBuffer(i) = GlobalAlloc(%GMEM_MOVEABLE Or %GMEM_DDESHARE, 0)
                'hBuffer(i) = GlobalAlloc(%GMEM_MOVEABLE Or %GMEM_DDESHARE or %GMEM_DISCARDABLE, 0)
                'hBuffer(i) = GlobalAlloc(%GMEM_DDESHARE, 0)
            Next i

            Call RegisterHotKey(hDlg, 0, %HK_CONTROL Or %HK_ALT Or %HK_SHIFT, %VK_ADD)
            Call RegisterHotKey(hDlg, 1, %HK_CONTROL Or %HK_ALT, %VK_ADD)

            Control Set Focus hDlg, %cmdLog

    End Select
End Function

Function frmMain_CallBack(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Select Case uMsg
        Case %WM_COMMAND
            Select Case HiWrd(wParam)
                Case %BN_CLICKED
                    Select Case LoWrd(wParam)
                        Case %cmdExit
                            ialog End hDlg
                        Case %cmdLog
                            If bLog Then
                                bLog = 0
                                Call DeleteTimer(hLog, 1)
                                Control Set Text hDlg, %cmdLog, "Start"
                            Else
                                bLog = 1
                                Call TimerProc01(0, 0, 0, 0)
                                Call CreateTimer(hLog, 1000, 1)
                                Control Set Text hDlg, %cmdLog, "[Stop]"
                            End If
                    End Select

            End Select

        Case %WM_HOTKEY
            Select Case wParam
                Case 0      ' Ctrl + Shift + Alt + "+"
                    Call ClearClipboard()
                Case 1      ' Ctrl + Alt + "+"
                    Call ClearBuffer()
                Case < 20   ' Ctrl + ..
                    Call PasteFromBuffer(wParam - 10)
                Case < 30   ' Alt + ..
                    Call CopyToBuffer(wParam - 20)
                Case < 40   ' Ctrl + Alt + ..
                    Call DeleteFromBuffer(wParam - 30)
            End Select

        Case %WM_DESTROY
          Local i As Byte

            For i = 0 To %Buff_Num - 1
                Call UnregisterHotKey(hDlg, 10 + i)
                Call UnregisterHotKey(hDlg, 20 + i)
                Call UnregisterHotKey(hDlg, 30 + i)

                Call GlobalFree(hBuffer(i))
            Next i

            Call UnregisterHotKey(hDlg, 0)
            Call UnregisterHotKey(hDlg, 1)

            Call DeleteTimer(hLog, 1)

            Call UnHookWnd(%cmdLog)
            Call UnHookWnd(%cmdExit)
            Call UnHookWnd(%txtText)
            Call UnHookWnd(%frmMain)

    End Select

    Function = CallWindowProc(PrevProc(%frmMain), hWnd, uMsg, wParam, lParam)
End Function

Function txtText_CallBack(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Select Case uMsg
    End Select

    Function = CallWindowProc(PrevProc(%txtText), hWnd, uMsg, wParam, lParam)
End Function

Function cmdExit_CallBack(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Select Case uMsg
    End Select

    Function = CallWindowProc(PrevProc(%cmdExit), hWnd, uMsg, wParam, lParam)
End Function

Function cmdLog_CallBack(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Select Case uMsg
    End Select

    Function = CallWindowProc(PrevProc(%cmdLog), hWnd, uMsg, wParam, lParam)
End Function

Sub TimerProc01(ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long)
Local t As Long, h As Long, m As Long, s As Long
    t = GetTickCount \ 1000
    h = Int(t / 3600)
    m = Int((t - (h * 3600)) / 60)
    s = Int(t - ((h * 3600) + (m * 60)))

    Control Set Text hDlg, %lblInfo, Format$(h, "00" & ":" & Format$(m, "00" & ":" & Format$(s, "00"
End Sub
' # CallBacks #
' =============

' ====================
' # Functions / Subs #
Sub HookWnd(ByVal id As Byte)
    Select Case id
        Case %frmMain
            PrevProc(id) = SetWindowLong(hDlg, %GWL_WNDPROC, CodePtr(frmMain_CallBack))
        Case %txtText
            PrevProc(id) = SetWindowLong(hText, %GWL_WNDPROC, CodePtr(txtText_CallBack))
        Case %cmdExit
            PrevProc(id) = SetWindowLong(hExit, %GWL_WNDPROC, CodePtr(cmdExit_CallBack))
    End Select
End Sub

Sub UnHookWnd(ByVal id As Byte)
    Select Case id
        Case %frmMain
            Call SetWindowLong(hDlg, %GWL_WNDPROC, PrevProc(id))
        Case %txtText
            Call SetWindowLong(hText, %GWL_WNDPROC, PrevProc(id))
        Case %cmdExit
            Call SetWindowLong(hExit, %GWL_WNDPROC, PrevProc(id))
    End Select
End Sub

Sub CreateTimer(ByVal hWnd As Long, ByVal Interval As Long, ByVal id As Byte)
    Local FuncPtr As Long
    Select Case id
        Case 1 ' 1-st timer
            FuncPtr = CodePtr(TimerProc01)
       ' Case 2 ' 2-nd timer
       '     FuncPtr = CodePtr(TimerProc02)
    End Select

    Call SetTimer(hWnd, id, Interval, FuncPtr)
End Sub

Sub DeleteTimer(ByVal hWnd As Long, ByVal id As Byte)
    Call KillTimer(hWnd, id)
End Sub
' # Functions / Subs #
' ====================

' =============
' # Main Code #
Sub CopyToBuffer(ByVal id As Long)
Dim hClipboard As Dword
Dim BuffPtrSrc As Dword
Dim BuffPtrDest As Dword
Dim sBuff As Asciiz * 512

    If OpenClipboard(hDlg) Then
        hClipboard = GetClipboardData(%CF_TEXT)
        BuffPtrSrc = GlobalLock(hClipboard)

        hBuffer(id) = GlobalReAlloc(hBuffer(id), GlobalSize(hClipboard), %GMEM_MOVEABLE)
        BuffPtrDest = GlobalLock(hBuffer(id))

        If BuffPtrDest Then
            Call CopyMemory(BuffPtrDest, BuffPtrSrc, GlobalSize(hClipboard))

            If GlobalSize(hClipboard) > 512 Then
                Call CopyMemory(VarPtr(sBuff), BuffPtrDest, 512)
            Else
                Call CopyMemory(VarPtr(sBuff), BuffPtrDest, GlobalSize(hClipboard))
            End If

            Control Set Text hDlg, %lblInfo, Format$(id) & " [Copy] """ & sBuff & """"
        Else
            Control Set Text hDlg, %lblInfo, Format$(id) & " [Copy] Error"
        End If
        GlobalUnlock(hBuffer(id))
        GlobalUnlock(hClipboard)
        Call CloseClipboard
    End If
End Sub

Sub PasteFromBuffer(ByVal id As Long)
Local BuffPtrSrc As Dword
Local sBuff As Asciiz * 512

    If GlobalSize(hBuffer(id)) Then
        If OpenClipboard(hDlg) Then
            BuffPtrSrc = GlobalLock(hBuffer(id))
            If BuffPtrSrc Then
                Call CopyMemory(VarPtr(sBuff), BuffPtrSrc, GlobalSize(hBuffer(id)))
                Control Set Text hDlg, %lblInfo, Format$(id) & " [Paste] """ & sBuff & """"
            End If
            Call GlobalUnlock(hBuffer(id))

            Call SetClipboardData(%CF_TEXT, 0)
            Call SetClipboardData(%CF_TEXT, hBuffer(id))

            Call GlobalUnlock(hBuffer(id))
            Call CloseClipboard

            Call VirtualKey(%VK_CONTROL, %VK_V)
        End If
    Else
        Control Set Text hDlg, %lblInfo, Format$(id) & " Empty"
    End If
End Sub

Sub DeleteFromBuffer(ByVal id As Long)
    If GlobalSize(hBuffer(id)) Then
        Call GlobalReAlloc(hBuffer(id), 0, %GMEM_MOVEABLE)
    End If
End Sub

Sub ClearBuffer()
Local i As Byte
    For i = 0 To %Buff_Num - 1
        If GlobalSize(hBuffer(i)) Then
            Call GlobalReAlloc(hBuffer(i), 0, %GMEM_MOVEABLE)
        End If
    Next i
End Sub

Sub ClearClipboard()
    If OpenClipboard(hDlg) Then
        Call SetClipboardData(%CF_TEXT, 0)
        Call CloseClipboard
    End If
    
'    If OpenClipboard(hDlg) Then
'        Call EmptyClipboard
'        Call CloseClipboard
'    End If
End Sub

' # &#207;&#240;&#238;&#246;&#229;&#228;&#243;&#240;&#224; &#253;&#236;&#243;&#235;&#255;&#246;&#232;&#232; &#237;&#224;&#230;&#224;&#242;&#232;&#255; &#238;&#228;&#237;&#238;&#233;/&#228;&#226;&#243;&#245;/&#242;&#240;&#229;&#245; &#234;&#235;&#224;&#226;&#232;&#248;
Sub VirtualKey(VK_Key1 As Long, Optional ByVal VK_Key2 As Long, Optional ByVal VK_Key3 As Long)
    Call keybd_event(VK_Key1, 0, 0, 0)
    Call keybd_event(VK_Key2, 0, 0, 0)
    Call keybd_event(VK_Key3, 0, 0, 0)
    Call keybd_event(VK_Key1, 0, %KEYEVENTF_KEYUP, 0)
    Call keybd_event(VK_Key2, 0, %KEYEVENTF_KEYUP, 0)
    Call keybd_event(VK_Key3, 0, %KEYEVENTF_KEYUP, 0)
End Sub
' # Main Code #
' =============

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Get text from ClipBoard
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Function edmClipboardGetText () As String
  Local Bytes As Long, cbPtr As Byte Ptr, zPtr As Asciiz Ptr

  If OpenClipboard(0) Then               ' try to claim clipboard for ourselves
     cbPtr = GetClipboardData(%CF_TEXT)  ' see if there is any text data available
     If cbPtr Then
        zPtr = GlobalLock(cbPtr)         ' lock the memory address/handle and get pointer to text
        If zPtr Then Function = @zPtr    ' if success, zPtr points to the text
        GlobalUnlock cbPtr               ' decrement the lock count
     End If
     CloseClipboard                      ' release clipboard
  End If

End Function

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Put text into ClipBoard
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Function edmClipboardPutText (ByVal txt As String) As Long
  Local cbPtr As Long, hData As Long, Bytes As Long

  txt = txt + Chr$(0)                    ' make it an ASCIIz string
  Bytes = Len(txt)                       ' get # of bytes to load
  If Bytes < 2 Then Exit Function        ' if no bytes to load

  hData = GlobalAlloc(&H2002, Bytes)     ' get memory address of clipboard
  cbPtr = GlobalLock(hData)              ' lock and get pointer to data
  Poke$ cbPtr, txt                       ' paste the text into memory
  GlobalUnlock hData                     ' unlock memory

  If IsFalse OpenClipboard(0) Then       ' if clipboard isn't available
    GlobalFree hData                     ' free up memory
    Exit Function                        ' Return false
  End If

  EmptyClipboard                         ' empty whatever's in there now
  SetClipboardData %CF_TEXT, ByVal hData ' point the clipboard at it as text
  CloseClipboard                         ' release clipboard

  Function = %TRUE                       ' return true
End Function