หน้าแรก
 การบ้าน
  C/C++ new
  Java new
 Sourcecode.TV
  Android
  Blackberry
  C/C++
  Java
  Linux
  Windows Phone
  แจ้งเรื่องที่ต้องการ
 บทความ
  .NET
  Android
  Blackberry
  C++Builder
  Delphi
  Java
  Mobile
  Open Source
  Pocket PC
  Visual Basic
  Web
  Windows Phone
  Others
 แบบเรียนฟรี
  ASP
  ASP.NET Webmatrix
  C++
  eVB
  J2ME
  Java
  PHP
 ซอร์สโค้ด
  Android
  ASP
  C++
  VC++
  CGI-Perl
  Delphi
  Java
  jQuery
  PHP
  Visual Basic
  .NET
 บริการจากเรา
  เปิดท้าย... ขายโค้ด
  DoodeeHosting
  รับออกแบบ พัฒนาเว็บไซต์
  Freeware
  อัตราค่าโฆษณา
  รายชื่อลูกค้า
  สถิติผู้เข้าเว็บ
 ดาว์นโหลด
 ค้นหาข้อมูล
 กระดานสนทนา
  .NET
  C/C++
  Delphi
  Java
  Palm/PocketPC
  Visual Basic
  Web
  อื่นๆ
 กระดานงาน
 ลิงค์เว็บ
 เกี่ยวกับผม
 อัตราค่าโฆษณา
Social Network

Facebook  Twitter  YouTube
 New Article
 Webboard
 Freelanceboard
Freeware
โปรแกรมเบอร์ดี (BerDee)
โปรแกรมเบอร์ดี (Android)
เกมส์เป่ายิ้งฉุบ
เกมส์เป่ายิ้งฉุบ(Android)
WebcamMonitor
WebcamMonitor(Windows)
scSendMail
scSendMail(Windows)
MSN Caption
MSN Caption(Windows)
  Freelance comment
  ติดต่อสอบถามมาได้ตลอดนะ...
2015-07-29 13:35:58
  ถ้าผมต้องการเว็บที่พัฒน...
2015-01-18 15:33:54
  ถ้าผมต้องการเว็บที่พัฒน...
2015-01-18 15:32:51
  ติดต่อสอบถามเข้ามาได้นะ...
2014-01-06 12:47:38
  ถ้ายังหาคนสอนไม่ได้ ก็ลอ...
2013-07-06 01:04:37
  สนใจส่งขอบเขตมาคุยราคาก...
2013-03-24 18:54:20
  ถ้ายังไม่มีคนรับงานติดต...
2012-12-16 19:18:14
  สนใจคะ ติดต่อ 0905076277...
2012-11-12 11:07:46
  รับทำโปรเจ็คนักศึกษาหรื...
2012-10-29 03:10:46
  sukit_te34@hotmail.com...
2012-10-29 03:09:36
  Webboard comment
  พอดีผมเห...
2020-05-31 21:49:43
  ช่วย แสดง...
2020-04-27 11:21:00
  ได้การบ้...
2020-04-27 11:18:56
  ได้การบ้...
2020-04-27 11:02:44
  <a href="https://www.g...
2020-03-10 17:07:03
  ไม่อยากเ...
2020-03-10 17:05:36
  ขอโคํดเก...
2020-02-09 22:50:58
  ขอโค้ดเก...
2020-01-28 23:42:26
  uuu...
2020-01-24 11:54:34
  ก็ต้องลง ...
2019-10-22 01:56:28
  Homework comment
  โจทย์การบ้าน c++ เขียนรูปแ...
2020-04-06 11:01:33
  แบบนี้ขอเป็น ภาษา php หน่อย...
2019-09-18 14:36:34
  ผมไม่อยากให้คุณได้คะแนน...
2019-04-27 01:29:07
  อาจารย์เขาบอกแนวข้อสอบม...
2019-04-27 00:44:29
  ขอสอบถามการเขียน c++ ครับ เ...
2018-04-02 12:19:21
  โค้ดตัวอย่างศึกษาให้เข้...
2017-11-26 14:50:05
  คำนวณค่าน้ำโดยรับค่ามิเ...
2017-11-20 23:15:26
  ขอบคุณมากครับ...
2017-08-16 18:27:25
  ทำเอง งง เอง กะลังทำใหม่ค...
2017-04-18 18:40:46
  ทำเอง งง เอง กะลังทำใหม่ค...
2017-04-18 18:37:54
  Article comment
  ต้องการ ให้เขียน โปรแกรม ...
2019-12-09 11:39:58
  รับเขียน arx จาก vc++ 2017 ล็อคโปร...
2019-09-19 09:48:09
  ทำการ register ไฟล์ที่ชื่อ mswinsck.oc...
2019-09-17 14:05:56
  ใน vb 6 ไม่มี component winsock เลยค่ะ ส...
2019-09-03 10:31:02
  รบกวนขอสอบถามหน่อยนะครั...
2019-03-04 05:31:04
  สามารถนำตัวหนังสือจากภา...
2018-12-25 08:54:32
  มีcode ของ VB ไหมค่ะ ถ้ามีรบกว...
2017-09-28 16:50:02
  น่าจะได้ครับ ไม่เคยลอง
...

2017-07-11 09:59:35
  สามารถใช้ต่อกับ anycast ได้ไห...
2017-07-05 10:12:35
  ครับ คุณ "ติด" แล้วลองนึกต...
2016-06-18 15:21:09
  9Mcode comment
  อยากได้...
2014-02-21 08:52:19

Link Exchange

อัตราค่าโฆษณา
Statistics of Sourcecode in Thailand
 
 Webboard

- - - - - - - - - - - - - - ผู้ให้การสนับสนุน- - - - - - - - - - - - - -

กระทู้ #2138 [Vb]

จะทำยังงัยให้ติดต่อกับserver จำลองส่งหน้าเว็บ แล้วเรียกผ่าน localhost ได้ ครับ



คือ ผมงง นะครับว่าเราจะมีวิธีอย่างไรให้เรียกหน้าเว็บเพจ ที่เขียนไว้แล้วในsever จำลองแล้ว พอเรียกผ่าน localhost แล้ว จะเรียกหน้า ที่เราเขียนไว้ในserver ขึ้นมาอะครับ
แนะนำด้วยครับ

Dim HTTPs As Byte
Public pwrite, pread As Integer
'Public Magic, user, pass As String
'Public lUser, Lpass As String
Public data As Integer

Private Sub btnAddIp_Click()
rasp = InputBox("enter the IP", "IP rules")
If rasp <> "" Then lstIPs.AddItem rasp
End Sub

Private Sub btnEdit_Click()
frmEdit.Show
End Sub

Private Sub btnExit_Click()
Out pwrite, &H2
RemoveFromTray
End
End Sub

'HTTP server functions
Public Sub btnHTTPon_Click()
On Error Resume Next
sckHTTP(0).LocalPort = txtHTTPport.Text

Do While sckHTTP(0).State <> sckClosed
sckHTTP(0).Close
DoEvents
Loop

sckHTTP(0).Listen

Label5.Caption = "Network Connected"
Label5.BackColor = vbGreen
Label5.ForeColor = vbBlack
lblBrowse.Visible = True
lblAddress.Visible = True
lblAddress.Caption = sckHTTP(0).LocalIP & ":" & txtHTTPport.Text

For i = 0 To 1
If optHTTP(i).Value = False Then optHTTP(i).Enabled = False
Next i


'RemoveFromTray

' AddToTray Me, mnu.option1
' SetTrayIcon frmMain.Icon
' SetTrayTip
'frmMain.Hide
'On Error Resume Next


End Sub

Public Sub btnHTTPoff_Click()
On Error Resume Next
For i = 1 To HTTPs
sckHTTP(i).Close
Unload sckHTTP(i)
Next i
sckHTTP(0).Close
Label5.Caption = "Network Connection Closed"
Label5.BackColor = vbRed
Label5.ForeColor = vbWhite
lblBrowse.Visible = False
lblAddress.Visible = False

For i = 0 To 1
If optHTTP(i).Value = False Then optHTTP(i).Enabled = True
Next i

End Sub

Private Sub btnRemoveIp_Click()
If lstIPs.ListIndex <> -1 Then lstIPs.RemoveItem (lstIPs.ListIndex)
End Sub

Private Sub cmdDOOR1_Click()
Call ctrlDoor1

End Sub

Private Sub cmdDOOR2_Click()
Call ctrlDoor2

End Sub

Private Sub cmdLight_Click()
Call ctrlLight
End Sub

Private Sub Form_Load()
pread = &H379
pwrite = &H378


IsAdmin = False
Out pwrite, &H2
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
Me.PopupMenu mnu.Option2
End If
End Sub

Private Sub Form_Terminate()
RemoveFromTray
End
End Sub

Private Sub frmHTTP_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
Me.PopupMenu mnu.Option2
End If
End Sub

Private Sub Label12_Click()
frmAbout.Show
End Sub


Public Sub sckHTTP_close(Index As Integer)
If Index <> 0 Then
sckHTTP(Index).Close
Unload sckHTTP(Index)
HTTPs = HTTPs - 1
End If
End Sub

Public Sub sckhttp_ConnectionRequest(Index As Integer, ByVal requestID As Long)
On Error Resume Next
If Index = 0 Then
If checkIPlist(sckHTTP(0).RemoteHostIP) = 1 Then Exit Sub
HTTPs = HTTPs + 1
Load sckHTTP(HTTPs)
sckHTTP(HTTPs).LocalPort = 0
sckHTTP(HTTPs).accept requestID
End If
End Sub

Public Sub sckHTTP_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim data As String
Dim cmd As String

sckHTTP(Index).GetData data
'Debug.Print data
If Mid$(data, 1, 3) = "GET" Then
If optHTTP(0).Enabled = True Then
sendHTTP Index, ""
Else
sendWAP Index, ""
End If
ElseIf Mid$(data, 1, 4) = "POST" Then
cmd = Mid(data, InStr(1, data, "Command=") + 8, Len(data))
Call sendCmdResult(Index, cmd)
End If

End Sub

Public Sub sckhttp_sendcomplete(Index As Integer)
sckHTTP(Index).Close
Unload sckHTTP(Index)
HTTPs = HTTPs - 1
End Sub


ส่วนนี้นะครับ Index.html
'Index ¢Í§¿ÍÃìÁ http internet browser
Public Sub sendHTTP(ByVal Index As Integer, ByVal HTTPdata As String)

initPage = "<html><head><title>- - -Server Control System- - -</title>" _
& "</head><body bgcolor=#000000 text=#0099CC>" _
& "<p align=center><b><font color=#00CCFF >Server Control</b>" _
& "<hr><form name=form1 method=POST><b><font color=#00CCFF> <input type=submit " _
& "name=Send value=Command:> <input type=text name=Command size=36>" _
& "</form><hr></font></b><br>Command Control</br><br>===============================</br><br>[Long Command] [Short Command] [Command Arguments]</br><br>===============================</br><br>[/lockdoor1] [/11] Lock Door1</br><br>=====================</br><br>[/lockdoor2] [/21] Lock Door2 </br><br>=====================</br><br>[/openlight] [/31] Open Light </br><br>=====================</br><br>[/unlockdoor1] [/10] Unlock Door1</br><br>=====================</br><br>[/unlockdoor2] [/20] Unlock Door2</br><br>=====================</br><br>[/closelight] [/30] Close Light</br><br>=====================</br>"

'á»ÅÊÓËÃѺÍØ»¡Ã³ì browser
HTTPdata = Replace(HTTPdata, "<", "<")
HTTPdata = Replace(HTTPdata, ">", ">")
HTTPdata = Replace(HTTPdata, " ", " ")
HTTPdata = Replace(HTTPdata, vbCrLf, "<br>")
HTTPdata = "<font color=#00FFFF face=courier new>" & HTTPdata & "</font></body></html>"

httpTemp = mimeHeader(200, Len(initPage) + 14 + Len(HTTPdata), "", "keep-alive") _
& initPage & HTTPdata
sckHTTP(Index).SendData httpTemp
'Debug.Print httpTemp
End Sub

Public Sub sendWAP(ByVal Index As Integer, ByVal HTTPdata As String)

initPage = "<?xml version=""1.0"" encoding=""iso-8859-1""?>" & vbCrLf _
& "<!DOCTYPE wml PUBLIC ""-//WAPFORUM//DTD WML 1.3//EN"" ""http://www.wapforum.org/DTD/wml13.dtd"">" & vbCrLf _
& "<wml>" & vbCrLf & "<card id=""init"" title=""---Mobile Control---"">" & vbCrLf _
& "<p align=""center""><b>Command Control : </b><input type=""text"" name=""Command""/><do type=""accept"" label=""send""><go method=""post"" href=""http://" & sckHTTP(0).LocalIP & ":" & sckHTTP(0).LocalPort & """><postfield name=""Command"" value=""$(Command)""/></go></do></p>" & vbCrLf & "<p>/lockdoor1 /11</p><p>/lockdoor2 /21</p><p>/openlight /31</p><p>/unlockdoor1 /10</p><p>/unlockdoor2 /20</p><p>/closelight /30</p>" & vbCrLf _

'á»ÅÊÓËÃѺÍØ»¡Ã³ì wap
HTTPdata = Replace(HTTPdata, "<", "<")
HTTPdata = Replace(HTTPdata, ">", ">")
HTTPdata = Replace(HTTPdata, vbCrLf, "<br>")

If Len(initPage) + Len(HTTPdata) > 1800 Then HTTPdata = Mid(HTTPdata, 1, 1800)

HTTPdata = HTTPdata & "</card></wml>"

httpTemp = "HTTP/1.1 200 OK" & vbCrLf _
& "Date: " & Format(Now, "ddd, d mmm yyyy ") & Format(sTime, " hh:mm:ss ") & "GMT" & vbCrLf _
& "Server: Mobile Control Server" & vbCrLf _
& "Last-Modified: " & Format(Now, "ddd, d mmm yyyy ") & Format(sTime, " hh:mm:ss ") & "GMT" & vbCrLf _
& "Accept-Ranges: bytes" & vbCrLf _
& "Content-Length: " & Len(initPage) + Len(HTTPdata) & vbCrLf _
& "Connection: keep-alive" & vbCrLf _
& "Content-Type: text/vnd.wap.wml" & vbCrLf & vbCrLf _
& initPage & HTTPdata

sckHTTP(Index).SendData httpTemp
'Debug.Print httpTemp
End Sub

Function mimeHeader(httpCode As Integer, dataLength As Long, fileExt As String, conType As String) As String
Dim mimeType As String
Dim sDate As Date
Dim sTime As Date
sDate = Date
sTime = Time
Select Case fileExt
Case "htm": mimeType = "text/html"
Case "wml": mimeType = "text/vnd.wap.wml ;charset=UTF-8"
Case Else: mimeType = "text/plain"
End Select

mimeHeader = "HTTP/1.0 " & Str(httpCode) & " " & getReason(httpCode) & vbCrLf _
& "Date: " & Format(sDate, "ddd, d mmm yyyy ") & Format(sTime, " hh:mm:ss ") & "GMT" & vbCrLf _
& "Server: Server Control System" & vbCrLf _
& "MIME-version: 1.0" & vbCrLf _
& "Content-type: " & mimeType & vbCrLf _
& "Connection: " & conType & vbCrLf _
& "Content-length: " & Str(dataLength) & vbCrLf & vbCrLf
End Function

Function getReason(httpCode As Integer) As String
Select Case httpCode
Case 200: getReason = "OK"
Case 201: getReason = "Created"
Case 202: getReason = "Accepted"
Case 204: getReason = "No Content"
Case 304: getReason = "Not Modified"
Case 400: getReason = "Bad Request"
Case 401: getReason = "Unauthorized"
Case 403: getReason = "Forbidden"
Case 404: getReason = "Not Found"
Case 500: getReason = "Internal Server Error"
Case 501: getReason = "Not Implemented"
Case 502: getReason = "Bad Gateway"
Case 503: getReason = "Service Unavailable"
Case Else: getReason = "Unknown"
End Select
End Function

Public Sub sendCmdResult(Index As Integer, ByVal cmd As String)
xtemp = cmdResult(Index, cmd)
If xtemp <> "" Then
If optHTTP(0).Value = True Then
sendHTTP Index, xtemp
Else
sendWAP Index, xtemp
End If
End If
End Sub

Public Function checkIPlist(hostIP As String) As Byte
If lstIPs.ListCount = 0 Then checkIPlist = 1
For i = 0 To lstIPs.ListCount - 1
If Option1.Value = True Then
If hostIP = Trim(lstIPs.List(i)) Then Exit Function
Else
If hostIP = Trim(lstIPs.List(i)) Then
checkIPlist = 1
Exit Function
End If
End If
Next i
End Function

Public Function cmdResult(Index As Integer, ByVal cmd As String) As String
On Error Resume Next
'first we translate from http
cmd = Replace(cmd, vbCrLf, "", , , vbTextCompare)
cmd = Replace(cmd, "+", " ", , , vbTextCompare)
cmd = Replace(cmd, "%20", " ", , , vbTextCompare)
cmd = Replace(cmd, "%21", "!", , , vbTextCompare)
cmd = Replace(cmd, "%22", Chr(34), , , vbTextCompare)
cmd = Replace(cmd, "%A7", "§", , , vbTextCompare)
cmd = Replace(cmd, "%24", "$", , , vbTextCompare)
cmd = Replace(cmd, "%25", "%", , , vbTextCompare)
cmd = Replace(cmd, "%26", "&", , , vbTextCompare)
cmd = Replace(cmd, "%2F", "/", , , vbTextCompare)
cmd = Replace(cmd, "%28", "(", , , vbTextCompare)
cmd = Replace(cmd, "%29", ")", , , vbTextCompare)
cmd = Replace(cmd, "%3D", "=", , , vbTextCompare)
cmd = Replace(cmd, "%3F", "?", , , vbTextCompare)
cmd = Replace(cmd, "%B2", "²", , , vbTextCompare)
cmd = Replace(cmd, "%B3", "³", , , vbTextCompare)
cmd = Replace(cmd, "%7B", "{", , , vbTextCompare)
cmd = Replace(cmd, "%5B", "[", , , vbTextCompare)
cmd = Replace(cmd, "%5D", "]", , , vbTextCompare)
cmd = Replace(cmd, "%7D", "}", , , vbTextCompare)
cmd = Replace(cmd, "%5C", "\", , , vbTextCompare)
cmd = Replace(cmd, "%DF", "ß", , , vbTextCompare)
cmd = Replace(cmd, "%23", "#", , , vbTextCompare)
cmd = Replace(cmd, "%27", "'", , , vbTextCompare)
cmd = Replace(cmd, "%3A", ":", , , vbTextCompare)
cmd = Replace(cmd, "%2C", ",", , , vbTextCompare)
cmd = Replace(cmd, "%3B", ";", , , vbTextCompare)
cmd = Replace(cmd, "%60", "`", , , vbTextCompare)
cmd = Replace(cmd, "%7E", "~", , , vbTextCompare)
cmd = Replace(cmd, "%2B", "+", , , vbTextCompare)
cmd = Replace(cmd, "%B4", "´", , , vbTextCompare)

If cmd = "?" Then
cmdResult = openPage(App.Path & "\webcommands.txt")
Exit Function
End If

If Left(cmd, 1) = "/" Then
spcol = InStr(1, cmd, " ")
If spcol < 1 Then spcol = Len(cmd) + 1
args = Mid(cmd, spcol + 1, Len(cmd))
cmd = Mid(cmd, 2, spcol - 2)
Else
args = cmd
cmd = "65"
End If

Select Case LCase(cmd)
Case "help"
ts = openPage(App.Path & "\webcommands.txt")
Case "xx", "exit"
End
Case "11", "lockdoor1"
Call webD1Lock
ts = "Door 1 locked successfull"
Case "21", "lockdoor2"
Call webD2Lock
ts = "Door 2 locked successfull"
Case "31", "openlight"
Call webLightOpen
ts = "Light Opened successfull"
Case "10", "unlockdoor1"
Call webD1Unlock
ts = "Door 1 Unlocked "
Case "20", "unlockdoor2"
Call webD2Unlock
ts = "Door 2 Unlocked "
Case "30", "closelight"
Call webLightClose
ts = "Light Closed "
'Case "wapcommand"
'Call checkWap
'MsgBox checkWap
'ts = openPage(App.Path & "\wapcommands.wml")
'Case "chkstatus"
' Call check
' ts = openPage(App.Path & "\status.dat")
Case "1131", "lockdoor1openlight"
Out pwrite, &H5
shpDOOR(0).BackColor = vbGreen
shpDOOR(2).BackColor = vbYellow
ts = "Door1 Locked and Light Opened "
Case "2131", "lockdoor2openlight"
Out pwrite, &H4
shpDOOR(1).BackColor = vbGreen
shpDOOR(2).BackColor = vbYellow
ts = "Door2 Locked and Light Opened "
Case "1031", "unlockdoor1openlight"
Out pwrite, &H4
shpDOOR(0).BackColor = vbRed
shpDOOR(2).BackColor = vbYellow
ts = "Door1 Unlocked and Light Opened "
Case "2031", "unlockdoor2openlight"
Out pwrite, &H6
shpDOOR(1).BackColor = vbRed
shpDOOR(2).BackColor = vbYellow
ts = "Door2 Unlocked and Light Opened "
Case "1130", "lockdoor1closelight"
Out pwrite, &H1
shpDOOR(0).BackColor = vbGreen
shpDOOR(2).BackColor = vbBlack
ts = "Door1 Locked and Light Closed "
Case "2130", "lockdoor2closelight"
Out pwrite, &H0
shpDOOR(1).BackColor = vbGreen
shpDOOR(2).BackColor = vbBlack
ts = "Door2 Locked and Light Closed "
Case "1121", "lockdoor1lockdoor2"
Out pwrite, &H1
shpDOOR(0).BackColor = vbGreen
shpDOOR(1).BackColor = vbGreen
ts = "Door1 Locked and Door2 Locked "
Case "1021", "unlockdoor1lockdoor2 "
Out pwrite, &H0
shpDOOR(0).BackColor = vbRed
shpDOOR(1).BackColor = vbGreen
ts = "Door1 Unlocked and Door2 Locked "
Case "1020", "unlockdoor1unlockdoor2"
Out pwrite, &H4
shpDOOR(0).BackColor = vbRed
shpDOOR(1).BackColor = vbRed
ts = "Door1Unlocked and Door2 Unlocked "
Case "112131", "lockdoor1lockdoor2openlight"
Out pwrite, &H5
shpDOOR(0).BackColor = vbGreen
shpDOOR(1).BackColor = vbGreen
shpDOOR(2).BackColor = vbYellow
ts = "Door1 Locked Door2 Locked Light Opened "
Case "102030", "unlockdoor1unlockdoor2closelight"
Out pwrite, &H2
shpDOOR(0).BackColor = vbRed
shpDOOR(1).BackColor = vbRed
shpDOOR(2).BackColor = vbBlack
ts = "Door1 Unlocked Door2 Unlocked Light Closed"
Case "1030", "unlockdoor1closelight"
Out pwrite, &H0
Out pwrite, &H2
shpDOOR(0).BackColor = vbRed
shpDOOR(2).BackColor = vbBlack
ts = "Door1 Unlocked and Light Closed "
Case "2030", "unlockdoor2closelight"
Out pwrite, &H2
shpDOOR(1).BackColor = vbRed
shpDOOR(2).BackColor = vbBlack
ts = "Door1 Locked and Light Closed "
Case Else
ts = "/" & cmd & args & " is not recognized as a valid command." &
End Select
cmdResult = ts
End Function

Public Function openPage(ByVal Filename As String) As String
On Error GoTo errore
freefileNr = FreeFile
If LCase(Dir(Filename)) <> LCase(JustName(Filename)) Then GoTo errore
Open Filename For Binary Access Read As #freefileNr
openPage = Space(LOF(freefileNr))
Get #freefileNr, , openPage
Close freefileNr
Exit Function
errore:
openPage = "error: could not load specified file."
End Function

Public Sub ctrlDoor1()
If shpDOOR(0).BackColor = vbRed Then
cmdDOOR1.Enabled = True
Out pwrite, &H1
shpDOOR(0).BackColor = vbGreen
Else: shpDOOR(0).BackColor = vbRed
Out pwrite, &H0
End If
End Sub
Public Sub ctrlDoor2()
If shpDOOR(1).BackColor = vbRed Then
cmdDOOR2.Enabled = True
Out pwrite, &H0
shpDOOR(1).BackColor = vbGreen
Else: shpDOOR(1).BackColor = vbRed
Out pwrite, &H2
End If
End Sub
Public Sub ctrlLight()
If shpDOOR(2).BackColor = vbBlack Then
cmdLight.Enabled = True
Out pwrite, &H4
shpDOOR(2).BackColor = vbYellow
Else: shpDOOR(2).BackColor = vbBlack
Out pwrite, &H0
End If
End Sub

Public Function JustName(ByVal s As String) As String
i = Len(s)
Do While Mid(s, i, 1) <> "\"
i = i - 1
If i = 0 Then Exit Do
Loop
If i > 1 Then
JustName = Right(s, Len(s) - i)
Else
JustName = s
End If
End Function

Public Sub webD1Lock()
Out pwrite, &H1
shpDOOR(0).BackColor = vbGreen
End Sub

Public Sub webD2Lock()
Out pwrite, &H0
shpDOOR(1).BackColor = vbGreen
End Sub

Public Sub webLightOpen()
Out pwrite, &H4
shpDOOR(2).BackColor = vbYellow
End Sub

Public Sub webD1Unlock()
Out pwrite, &H0
shpDOOR(0).BackColor = vbRed
End Sub

Public Sub webD2Unlock()
Out pwrite, &H2
shpDOOR(1).BackColor = vbRed
End Sub

Public Sub webLightClose()
Out pwrite, &H0
shpDOOR(2).BackColor = vbBlack
End Sub

Private Sub Timer1_Timer()
Dim onDevice, onMinute As String
Dim a, b, c, d, e, f As String

lblTimeInfo.Caption = Time()
a = Hour(Time)
b = Minute(Time)
a = Val(a)
b = Val(b)

onDevice = txtStartTime.Text
onMinute = txtMinstart.Text

SetTime = Val(onDevice)
SetMinute = Val(onMinute)
c = Int(SetTime)
'd = (SetTime - c) * 100
d = Int(SetMinute)
If a - c = 0 And b - d = 0 Then
'MsgBox chkDoor(0).Value & chkDoor(1).Value & chkDoor(2).Value
'Exit Sub
If chkDoor(1).Value = 1 Then
shpDOOR(1).BackColor = vbGreen
Out pwrite, &H0
Else
Out pwrite, &H2
shpDOOR(1).BackColor = vbRed
End If

If chkDoor(0).Value = 1 Then
shpDOOR(0).BackColor = vbGreen
Out pwrite, &H1
End If

If chkDoor(2).Value = 1 Then
shpDOOR(2).BackColor = vbYellow
Out pwrite, &H4
End If

If chkDoor(0).Value = 1 Then
If chkDoor(2).Value = 1 Then
Out pwrite, &H5
shpDOOR(0).BackColor = vbGreen
shpDOOR(2).BackColor = vbYellow
End If
End If

If chkDoor(1).Value = 1 Then
If chkDoor(2).Value = 1 Then
Out pwrite, &H4
shpDOOR(1).BackColor = vbGreen
shpDOOR(2).BackColor = vbYellow
End If
End If

If chkDoor(0).Value = 1 Then
If chkDoor(1).Value = 1 Then
Out pwrite, &H0
If chkDoor(2).Value = 1 Then
Out pwrite, &H5
shpDOOR(0).BackColor = vbGreen
shpDOOR(1).BackColor = vbGreen
shpDOOR(2).BackColor = vbYellow
End If
End If
End If

If chkDoor(0).Value = 1 Then
If chkDoor(1).Value = 1 Then
Out pwrite, &H1
shpDOOR(0).BackColor = vbGreen
shpDOOR(1).BackColor = vbGreen
End If
End If

End If

SetHour = txtHour.Text
SetMin = txtMinute.Text
SetHour = Val(SetHour)
SetMin = Val(SetMin)
e = c + SetHour
f = d + SetMin
If e > 23 Then e = e - 24
If f > 59 Then
f = f - 60
e = e + 1
End If
If a - e = 0 And b - f = 0 Then
shpDOOR(0).BackColor = vbRed
shpDOOR(1).BackColor = vbRed
shpDOOR(2).BackColor = vbBlack

Out pwrite, &H0
Out pwrite, &H2
chkDoor(0).Value = 0
chkDoor(1).Value = 0
chkDoor(2).Value = 0
txtStartTime.Text = ""
txtMinstart.Text = ""
End If

End Sub

Private Sub txtHour_Change()
SetHour = txtHour.Text
SetHour = Val(SetHour)
Select Case SetHour
Case Is > 23
MsgBox "¤èÒ·ÕèµéͧãÊèÁÕ¤èÒÃÐËÇèÒ§ 1-23", vbCritical + vbOKOnly, "ERROR"
txtHour.Text = ""
Case Is < 1
MsgBox "¤èÒ·ÕèµéͧãÊèÁÕ¤èÒÃÐËÇèÒ§ 1-23", vbCritical + vbOKOnly, "ERROR"
txtHour.Text = ""
End Select
End Sub

Private Sub txtMinute_Change()
SetMin = txtMinute.Text
SetMin = Val(SetMin)
Select Case SetMin
Case Is > 59
MsgBox "¤èÒ·ÕèµéͧãÊèÁÕ¤èÒÃÐËÇèÒ§ 1-59", vbCritical + vbOKOnly, "ERROR"
txtMinute.Text = ""
Case Is < 1
MsgBox "¤èÒ·ÕèµéͧãÊèÁÕ¤èÒÃÐËÇèÒ§ 1-59", vbCritical + vbOKOnly, "ERROR"
txtMinute.Text = ""
End Select
End Sub



ขอบพระคุณล่วงหน้าครับ

จากคุณ : ชัชวาล สุวรไตร / oilachi@hotmail.com [2008-07-10 22:44:38]  

58.8.252.192 ความคิดเห็น #26929 (จาก IP: 58.8.252.192)
ผมก็งง กับคำถามคุณ
คุณจะไปดึงหน้าเว็บคนอื่น มาแสดงบนเว็บตัวเอง หรืออย่างไร ???
จากคุณ : sup98 [2008-07-11 11:33:16]

158.108.109.192 ความคิดเห็น #26946 (จาก IP: 158.108.109.192)
อ๋อ คือ พอดีจะมีการเรียกสั่งงานผ่าน web browser
ติดต่อกับ window form ที่เขียนไว้นะครับ
ติดต่อทางport 80 ทางlocalhost นะครับ เราต้องทำงัยบ้างครับ
จากคุณ : ชัชวาล สุวรไตร / oilachi@hotmail.com [2008-07-17 23:43:59]

58.8.180.30 ความคิดเห็น #26947 (จาก IP: 58.8.180.30)
เปิด socket ที่ port 80 ครับ ค่อยรับ connection
จากคุณ : sup98 [2008-07-18 01:08:30]

118.175.130.51 ความคิดเห็น #26951 (จาก IP: 118.175.130.51)
เราต้องสร้างเว็บฟอร์มรึปล่าวครับในการป้อนคำสั่งหรือไม่สร้างครับ เพื่อติดต่อกับ web server นะครับ
แต่พอดีผมลองเรียกผ่าน http://127.0.0.1 มันมีpassword ไม่ได้ตั้งไว้นะครับ หรือว่าจะแก้ยังงัยครับ
จากคุณ : ชัชวาล สุวรไตร / oilachi@hotmail.com [2008-07-19 00:17:49]
ตอบกระทู้
  • ห้ามการโฆษณา หากต้องการติดต่อหาลูกค้า ติดต่อโฆษณาโดยตรงได้ที่ webmaster@sourcecode.in.th
  • ห้ามใช้คำหยาบและคำพูดที่ไม่เหมาะสม
  • ขอสงวนสิทธิหากตรวจพบ ข้อความที่ไม่เหมาะสม ข้อความนั้นจะถูกลบทันที
ชื่อ
อีเมล์
รายละเอียด

- - - - - - - - - - - - - - ผู้ให้การสนับสนุน- - - - - - - - - - - - - -

 
 
หัวแปลง Mini DisplayPort to HDMI Adapter หัวแปลง Mini DisplayPort to HDMI Adapter สำหรับเครื่อง macbook air/pro, mac mini
หัวแปลง Mini DisplayPort to HDMI Adapter สำหรับเครื่อง macbook air/pro, mac mini
คลิปสอนเขียนโปรแกรม
เรียนเขียนโปรแกรมดอทเน็ต
เรียนเขียนโปรแกรมแอนดรอยด์
เรียนเขียนโปรแกรมเบล็คเบอร์รี่
เรียนเขียนโปรแกรมซี ซีพลัสพลัส
เรียนเขียนโปรแกรมจาวา
เรียนการใช้งานลินุกส์
เรียนการเขียนโปรแกรมวินโดว์โฟน
เรียนการเขียนโปรแกรมพีเฮชพี มายเอสคิวเอล
9M Blog บอกเล่าเรื่องราว การเขียนโปรแกรมของ นายเอ็ม
บริการ ถ่ายภาพรับปริญญา
อัตราค่าโฆษณา
 
Tutorial
eVB Tutorial
ASP.NET Webmatrix Tutorial
J2ME Tutorial
C++  Tutorial
Java  Tutorial
PHP Tutorial
ASP Tutorial
 
แบบสำรวจ
Freelance รับพัฒนาโปรแกรม

Home - Article - Tutorial - Sourcecode - Dev Handbook - Search - WebBoard - Links - About Us

สงวนลิขสิทธิ์ ห้ามคัดลอก ทำซ้ำ แก้ไข ดัดแปลง ไม่ว่าในรูปแบบใด โดยไม่ได้รับอนุญาตเป็นลายลักษณ์อักษร
เลขทะเบียนพาณิชย์อิเล็กทรอนิกส์จากกระทรวงพาณิชย์: 7100503002000
Copyright 2001 SourceCode.in.th