Keskustelu: Koodit: VB6: Keskustelu 2 + "jäynä"

Sivun loppuun

Cooler [21.06.2004 23:40:38]

Tämä on ensimmäinen koodivinkkini ja kaikenlisäksi vielä oma ensimmäinen vähän isompi työ

Tässä on kaksi ohjelmaa Client ja Server

Tämä on vain kahdenkoneenkeskusteluohjelma, johon on lisätty pieni jäynä ominaisuus Client.hyväksi :D

Pahempia bugeja ei pitäisi olla mutta toisaalta
yhden asian voi tehdä aina niin monella eri tavalla.

Jahas ja mitä sitä tarvitaan
(Tärkeimmät)

Client:

4 TextBox.ia
TextVast
TextSend
TextIp
TextPort

5CommandButton.ia

ComTyh2
ComEnd
CmdCd
ComStop
ComAvaa

2Shape.a
off
Toimii

Winsock.s
Winsock1
Winsock2

Server:
4 TextBox.ia
TextVast
TextSend
TextIp
TextPort

3CommandButton.ia
ComTyh2
CmdPortti
ComEnd

2Shape.a
off
Toimii

Winsock.s
Winsock1
Winsock2

Client

Option Explicit
Private Sub CmdCd_Click()
'Tässä tarkistetaan mitä nappulassa lukee ja sitten toimitaan sen mukaan
    If CmdCd.Caption = "Avaa CD" Then
        Winsock2.SendData "CDAvaa"
        CmdCd.Caption = "Sulje CD"
    Else
        Winsock2.SendData "CDSulje"
        CmdCd.Caption = "Avaa CD"
    End If
End Sub

Private Sub ComAvaa_Click()
Winsock1.Close 'suljetaan  varmuudenvuoksi
Winsock2.Close 'suljetaan  varmuudenvuoksi

Winsock1.Connect TextIp.Text, TextPort.Text 'yhdistetään TextIp kentäs olevaan ip numeroon ja sitten käytetään TextPort kentässä olevaa porttia
Winsock2.Connect TextIp.Text, 8001 'yhdistetään TextIP kentäs olevaan ip numeroon ja käytetään porttia 8001
TextSend.Enabled = True 'TextSend kenttä on "käytettävissä"

Toimii.Visible = True 'Näytetään vihreä lamppu
off.Visible = False 'Piilotetaan punainen lamppu

TextSend.Enabled = True  'TextSend kenttä on käytettävissä
TextVast.Enabled = True  'TextVast kenttä on käytettävissä
CmdCd.Enabled = True 'CD aseman avaus nappula on aktiivinen
End Sub

Private Sub ComEnd_Click()
Winsock1.Close 'suljetaan kaikki yhteyden
Winsock2.Close 'suljetaan kaikki yhteyden
End 'lopetetaan ohjelma
End Sub
Private Sub ComStop_Click()
Winsock1.Close 'suljetaan kaikki yhteyden
Winsock2.Close 'suljetaan kaikki yhteyden

TextSend.Enabled = False  'TextSend kenttä on "suljettu"
TextVast.Enabled = False  'TextVast kenttä on "suljettu"

Toimii.Visible = False 'Piilotetaan vihreä lamppu
off.Visible = True 'Näytetään punainen lamppu

CmdCd.Enabled = False 'CD aseman avaus nappula ei ole aktiivinen
End Sub
Private Sub ComTyh2_Click()
TextVast.Text = "" 'tyhjennetään TextVast alue
End Sub

Private Sub Form_Load()
TextSend.Enabled = False  'TextSend kenttä on "suljettu"
TextVast.Enabled = False  'TextVast kenttä on "suljettu"

Toimii.Visible = False 'Piilotetaan vihreä lamppu
off.Visible = True 'Näytetään punainen lamppu

CmdCd.Enabled = False 'CD aseman avaus nappula ei ole aktiivinen

TextPort.Text = "3456" 'TextPort.iin laitetaan 3456 oletukseksi
End Sub

Private Sub Form_Unload(Cancel As Integer)
Winsock1.Close 'Winsock1 suljetaan
Winsock2.Close 'Winsock2 suljetaan
End 'ohjelma lopetetaan
End Sub
Private Sub MenCdClose_Click()
Winsock2.SendData "suljecd" 'lähettää serverille et pitää sulkea cd asema
End Sub
Private Sub MenCdOpen_Click()
Winsock2.SendData "avaacd" 'lähettää serverille et pitää avata cd asema
End Sub
Private Sub TextSend_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then  'jos painetaan Enteriä niin lähetetään TextSend kentässä oleva tieto Serverille
    KeyAscii = 0
 Winsock1.SendData "Client: " & TextSend.Text 'lähetetään tieto mikä on TextSend kentässä
 TextVast.Text = TextVast.Text & "Client: " & TextSend.Text & vbCrLf 'lisätään lähetetty teksit myös TexVastaa tyyliin: Client: TextSend
 TextVast.SelStart = Len(TextVast.Text)
    TextSend.Text = "" 'TextSend tyhjennetään tekstistä
    End If
End Sub

Private Sub Winsock1_Close()
'Winsock1 sulkeutuu niin suoritetaan seuraavat toiminpiteet
    If Winsock1.State <> sckNotConnected Then
        Winsock1.Close

Toimii.Visible = False 'Piilotetaan vihreä lamppu
off.Visible = True ' Näytetään punainen lamppu

TextSend.Enabled = False  'TextSend kenttä on "suljettu"
TextVast.Enabled = False  'TextVast kenttä on "suljettu"

CmdCd.Enabled = False 'CD aseman avaus nappula ei ole aktiivinen
    End If
End Sub

Private Sub winsock1_DataArrival(ByVal bytesTotal As Long)
'Kun Winscok1 ottaa vastaan dataa niin tehdään seuraavat toiminnot
Dim Command As String
Winsock1.GetData Command  'Data on nimetty Command.iksi
TextVast.Text = TextVast.Text & Command & vbCrLf
TextVast.SelStart = Len(TextVast.Text)

End Sub

Private Sub winsock1_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)
Toimii.Visible = False 'Piilotetaan vihreä lamppu
off.Visible = True 'Näytetään punainen lamppu

TextSend.Enabled = False  'TextSend kenttä on "suljettu"
TextVast.Enabled = False  'TextVast kenttä on "suljettu"

CmdCd.Enabled = False 'CD aseman avaus nappula ei ole aktiivinen

MsgBox "Serveriä ei löydy" 'Annetaan ilmoitus ettei servua löydy
End Sub

Private Sub Winsock2_Close()
'Winsock2 sulkeutuu niin suoritetaan seuraavat toiminpiteet
    If Winsock2.State <> sckNotConnected Then
        Winsock2.Close
        Winsock2.Listen
    End If
End Sub

Private Sub Winsock2_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)
TextSend.Enabled = False  'TextSend kenttä on "suljettu"
TextVast.Enabled = False  'TextVast kenttä on "suljettu"

Toimii.Visible = False 'Piilotetaan vihreä lamppu
off.Visible = True 'Näytetään punainen lamppu

CmdCd.Enabled = False 'CD aseman avaus nappula ei ole aktiivinen

MsgBox "Ei yhteyttä" 'Annetaan ilmoitus
End Sub

Server

Option Explicit
Private Sub CmdPortti_Click()
Winsock1.Close 'Winsock1 suljetaa
Winsock2.Close 'Winsock2 suljetaa

Winsock1.LocalPort = TextPort.Text 'käytetään haluttua porttia joka on syötetty TextPort kenttään
Winsock1.Listen 'Winsock1 kuuntelee
Winsock2.Listen 'Winsock2 kuuntelee

TextSend.Enabled = False  'TextSend kenttä on "suljettu"
TextVast.Enabled = False  'TextVast kenttä on "suljettu"

Toimii.Visible = False 'Piilotetaan vihreä lamppu
off.Visible = True ' Näytetään punainen lamppu
End Sub

Private Sub ComEnd_Click()
Winsock1.Close 'Winsock suljetaa
Winsock2.Close 'Winsock suljetaa
End ' Ohjelma lopetetaan
End Sub
Private Sub ComTyh2_Click()
TextVast.Text = "" 'tyhjennetään TextVast kenttä
End Sub

Private Sub Form_Load()

   Winsock1.Close 'Winsock suljetaa varmuudenvuoksi
   Winsock2.Close 'Winsock2 suljetaa varmuudenvuoksi
TextPort.Text = "3456" 'TextPort.iin laitetaan 3456 oletukseksi
TextIp.Text = Winsock1.LocalIP 'näytetään koneen ip osoite TextIp kentässä
   Winsock1.LocalPort = TextPort.Text 'TextPort.Text oleva numero on portti jota käytetään
   Winsock1.Listen 'Winsock kuuntelee
Winsock2.LocalPort = 8001 'määritellään Winscok2.selle portti 8001
Winsock2.Listen 'Winsock2 kuuntelee

TextSend.Enabled = False  'TextSend kenttä on "suljettu"
TextVast.Enabled = False  'TextVast kenttä on "suljettu"

Toimii.Visible = False 'Piilotetaan vihreä lamppu
off.Visible = True ' Näytetään punainen lamppu

End Sub

Private Sub Form_Unload(Cancel As Integer)
   Winsock1.Close 'Winsock suljetaa
   Winsock2.Close 'Winsock2 suljetaa
End Sub

Private Sub TextSend_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then 'jos painetaan Enteriä niin lähetetään TextSend kentässä oleva tieto Clientille
    KeyAscii = 0
 Winsock1.SendData "Server: " & TextSend.Text 'lähetetään tieto mikä on TextSend kentässä
 TextVast.Text = TextVast.Text & "Server: " & TextSend.Text & vbCrLf 'lisätään lähetetty teksit myös TexVastaa tyyliin: Server: TextSend
 TextVast.SelStart = Len(TextVast.Text)
    TextSend.Text = "" 'Tyhennetään TextSend kenttä
    End If
End Sub

Private Sub winsock1_Close()
    If Winsock1.State <> sckNotConnected Then
        Winsock1.Close
        Winsock1.Listen
Toimii.Visible = False 'Piilotetaan vihreä lamppu
off.Visible = True ' Näytetään punainen lamppu
TextSend.Enabled = False  'TextSend kenttä on "suljettu"
TextVast.Enabled = False  'TextVast kenttä on "suljettu"
    End If
End Sub

Private Sub winsock1_ConnectionRequest(ByVal requestID As Long)
   If Winsock1.State <> sckClosed Then
       Winsock1.Close
   End If
      Winsock1.Accept requestID
TextSend.Enabled = True  'TextSend kenttä on käytettävissä
TextVast.Enabled = True  'TextVast kenttä on käytettävissä
Toimii.Visible = True ' Näytetään vihreä lamppu
off.Visible = False ' Piilotetaan punainen lamppu
 End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
'Kun Winscok1 ottaa vastaan dataa niin tehdään seuraavat toiminnot
Dim txt As String
Winsock1.GetData txt 'Data on nimetty txt.iksi
TextVast.Text = TextVast.Text & txt & vbCrLf
TextVast.SelStart = Len(TextVast.Text)
End Sub
Private Sub winsock1_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)
   MsgBox "Ei yhteyttä"
Toimii.Visible = False 'Piilotetaan vihreä lamppu
off.Visible = True 'Näytetään punainen lamppu
TextSend.Text = "" 'Tyhennetään TextSend kenttä
TextSend.Enabled = False  'TextSend kenttä on "suljettu"
TextVast.Enabled = False  'TextVast kenttä on "suljettu"

End Sub

Private Sub Winsock2_Close()
'Winsock2 sulkeutuu niin suoritetaan seuraavat toiminpiteet
    If Winsock2.State <> sckNotConnected Then
        Winsock2.Close
        Winsock2.Listen
End If
End Sub

Private Sub Winsock2_ConnectionRequest(ByVal requestID As Long)
    If Winsock2.State <> sckClosed Then
        Winsock2.Close
       End If
        Winsock2.Accept requestID
End Sub

Private Sub Winsock2_DataArrival(ByVal bytesTotal As Long)
'tämä on tärkein osa, jotta jekku juttu toimisi oikein
Dim x As String
Dim data As String
Dim Command As String

Winsock2.GetData Command

Select Case Command

Case "CDAvaa" 'avaa cd aseman :D
x = mciSendString("Set CDAudio Door Open", "", 0, 0)

Case "CDSulje" 'Sulkee cd aseman :D
x = mciSendString("Set CDAudio Door Closed", "", 0, 0)

End Select 'Lopetetaan
End Sub

Server, Module1

'Ohjelmassa käytettävät funktiot
'Päätin laittaa tämän tänne "selkeyden" kannalta

'cd-avaaja alku
Declare Function mciSendString Lib "WINMM.DLL" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
'cd-avaajan loppu

pipopää [23.06.2004 20:01:27]

Makea ohjelma mutta seuraavaan versioon ehotan, että käytät tätä https://www.ohjelmointiputka.net/koodivinkit/24083-vb6-lähiverkon-koneiden-etsiminen koodivinkkiä avuksi ja muuten kanataa laitaa timeri silee, että cd ei aukea aina kun painaa napulaa vaan se odotaa ekaksi vaikka 5 sekuntia ettei tietokone jumaa.

sooda [24.06.2004 09:09:58]

Öh... MIten sä sisennät? :)

nomic [25.06.2004 03:10:01]

näyttää ihan kivalta ohjelmalta, en ole ehtinyt kokeilla kun ei ole tässä koneessa vb:tä

mutta tuntuu että optimoimisen varaa on ja ehkä pikkasen "liikaa" kommentointia, siis eihän siinä mitään pahaa ole mutta niinkin looginen asia kuin:
Private Sub Winsock2_Close()
'Winsock2 sulkeutuu niin suoritetaan seuraavat toiminpiteet
eiköhän jokainen tajua että supin sisällä kun on jotain niin se on toimenpide joka aktivoituu kun supi alkaa häiriköimään softaa...

mutta kokeilen joskus ja annan ehkä joskus jotain fiksuu palautettakin :)

hyvä idea kummiskin, helppo ja aloittelijatkin(niinkuin myös kokeneemmat) pääsevät kokeilemaan kuinka kaksi eri ideaa voidaan sisällyttään yhteen projektiin hyvin :)

Gwaur [26.06.2004 23:02:09]

Sisennykset on kieltämättä aika ... persoonalliset

Mestre [09.07.2004 18:59:15]

Ihan kiva, oon itekkin yrittäny tehä samantapasta.

Cooler [11.09.2006 15:15:30]

tän paketin kyl saa ku kysäsee tarvittaes.

tronttu [28.01.2008 21:05:51]

Juu... niin viittisitkö Cooleri laittaa paketin tuleen mulle : tronttu@hotmail.com tai sitte vaan linkkiä niin on muillekki hyätyä :D. Kiits.

Sivun alkuun

Vastaus

Aihe on jo aika vanha, joten et voi enää vastata siihen.

Kirjautuminen

Haku

Tehtävät

Kilpailu