Langsung saja ini screenshot dan kodenya.
Langkah Pembuatan Project
- Buat dua buah project, yaitu Project Client dan Project Server.
- Untuk Project Client terdiri atas 3 CommandButton, 1 Text untuk menampung IP Address komputer target (server), 1 label info koneksi dan 1 Component Microsoft Winsock Control 6.0. Lebih jelasnya lihat gambar di atas.
- UntukProject Server cukup 1 label info dan 1 Component Microsoft Winsock Control 6.0.
Copy Paste Code dibawah ini pada form Project Client.
'panggil URL
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
Private Const conSwNormal = 1
Private Sub ConnectToServer()
On Error Resume Next
WscClient.Connect Text1.Text, 2010
End Sub
Private Sub DisConnectToServer()
WscClient.Close
End Sub
Private Sub Command1_Click()
If Command1.Caption = "Connect" Then
ConnectToServer
ElseIf Command1.Caption = "Disconnect" Then
DisConnectToServer
Command1.Caption = "Connect"
Command2.Enabled = False
Command3.Enabled = False
lblInfo.Caption = "Belum Konek Server..."
End If
End Sub
Private Sub Command2_Click()
WscClient.SendData "enablereg"
End Sub
Private Sub Command3_Click()
WscClient.SendData "disablereg"
End Sub
Private Sub Form_Load()
WscClient.Protocol = sckTCPProtocol
End Sub
Private Sub Label1_Click()
ShellExecute hwnd, "open", "Http://vbasiccode.blogspot.com", vbNullString, vbNullString, conSwNormal
End Sub
Private Sub Label2_Click()
ShellExecute hwnd, "open", "http://vbasiccode.blogspot.com/2010/04/tutorial-ptc.html", vbNullString, vbNullString, conSwNormal
End Sub
Private Sub Label3_Click()
ShellExecute hwnd, "open", "http://www.facebook.com/OutOfStack", vbNullString, vbNullString, conSwNormal
End Sub
Private Sub WscClient_Close()
Command1.Caption = "Connect"
Command2.Enabled = False
Command3.Enabled = False
lblInfo.Caption = "Aplikasi Server Ditutup..."
End Sub
Private Sub WscClient_Connect()
lblInfo.Caption = "Terkoneksi dengan Server"
Command2.Enabled = True
Command3.Enabled = True
Command1.Caption = "Disconnect"
End Sub
Private Sub WscClient_DataArrival(ByVal bytesTotal As Long)
Dim date_primite As String
Dim Vector() As String
WscClient.GetData date_primite
Vector = Split(date_primite, "|")
Select Case Vector(0)
Case "laporan"
MsgBox Vector(1)
End Select
End Sub
Copy Paste Code dibawah ini pada form Project Server.
Private Sub Form_Load()
WskServer.LocalPort = 2010
WskServer.Listen
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
WskServer.Close
End Sub
Private Sub WskServer_Close()
WskServer.Close
WskServer.Listen
lblInfo.Caption = "Koneksi ditutup Client..."
End Sub
Private Sub WskServer_ConnectionRequest(ByVal requestID As Long)
WskServer.Close
WskServer.Accept requestID
lblInfo.Caption = "Terkoneksi dengan client..."
End Sub
Private Sub WskServer_DataArrival(ByVal bytesTotal As Long)
Dim date_primite As String
Dim Vector() As String
Dim regrun
Set regrun = CreateObject("WScript.Shell")
WskServer.GetData date_primite
Vector = Split(date_primite, "|")
Select Case Vector(0)
Case "disablereg"
regrun.regwrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableRegistryTools", 1, "REG_DWORD"
regrun.regwrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableRegistryTools", 1, "REG_DWORD"
WskServer.SendData "laporan|" + "Laporan dari Server:""Registry Server tidak dapat dibuka."""
Case "enablereg"
regrun.regwrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableRegistryTools", 0, "REG_DWORD"
regrun.regwrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableRegistryTools", 0, "REG_DWORD"
WskServer.SendData "laporan|" + "Laporan dari Server: ""Registry Server sudah dapat dibuka kembali."""
End Select
End Sub
Private Sub WskServer_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
WskServer.Close
WskServer.Listen
End Sub
Silahkan Download BasicRemoteDesktop.rar
Aplikasi dibuat di windows XP dan jika dijalankan di Windows 7 maka klik kanan dan jalankan aplikasi sebagai Administrator.
Semoga bermanfaat..Amin.
Tidak ada komentar:
Posting Komentar