CONTROL V
Collapse
This topic is closed.
X
X
-
-
-
-
-
'frmClient:
'The main Form of the Chat application
Private Const vbZLString As String = ""
Public Enum OPENFILENAME_FLAGS
OFN_ALLOWMULTISELECT = &H200
OFN_CREATEPROMPT = &H2000
OFN_ENABLEHOOK = &H20
OFN_ENABLETEMPLATE = &H40
OFN_ENABLETEMPLATEHANDLE = &H80
OFN_EXPLORER = &H80000
OFN_EXTENSIONDIFFERENT = &H400&
OFN_FILEMUSTEXIST = &H1000
OFN_HIDEREADONLY = &H4&
OFN_LONGNAMES = &H200000
OFN_NOCHANGEDIR = &H8&
OFN_NODEREFERENCELINKS = &H100000
OFN_NOLONGNAMES = &H40000
OFN_NONETWORKBUTTON = &H20000
OFN_NOREADONLYRETURN = &H8000
OFN_NOTESTFILECREATE = &H10000
OFN_NOVALIDATE = &H100
OFN_OVERWRITEPROMPT = &H2&
OFN_PATHMUSTEXIST = &H800
OFN_READONLY = &H1
OFN_SHAREAWARE = &H4000
OFN_SHAREFALLTHROUGH = 2
OFN_SHAREWARN = 0
OFN_SHARENOWARN = 1
OFN_SHOWHELP = &H10
OFS_MAXPATHNAME = 128
End Enum
Private Type OPENFILENAME
lStructSize As Long
hWndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
Flags As OPENFILENAME_FLAGS
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Private Declare Function GetSaveFileName Lib "comdlg32" Alias "GetSaveFileNameA" (lpOpenfilename As OPENFILENAME) As Long
Private Declare Function CommDlgExtendedError& Lib "comdlg32" ()
Public Function GetSaveAsName(ByVal sInName$, ByVal sInitialDir$) As String
Dim lpOFN As OPENFILENAME, sTemp$, nStrEnd&
With lpOFN
.lStructSize = Len(lpOFN)
.hWndOwner = hWnd
'"txt" extension
.lpstrFilter = "Text Document (.txt)" & vbNullChar & "*.doc" & vbNullChar & vbNullChar
.lpstrFile = sInName & String$(700, vbNullChar)
.nMaxFile = 700
.lpstrFileTitle = String$(260, vbNullChar)
.nMaxFileTitle = 260
.lpstrInitialDir = sInitialDir
.lpstrTitle = "Save Conversation As..."
.Flags = OFN_EXTENSIONDIFFERENT Or OFN_NOCHANGEDIR Or OFN_OVERWRITEPROMPT Or OFN_HIDEREADONLY
.lpstrDefExt = "txt"
End With
If GetSaveFileName(lpOFN) Then
sTemp = lpOFN.lpstrFile
nStrEnd = InStr(sTemp, vbNullChar)
If nStrEnd > 1 Then
GetSaveAsName = Left$(sTemp, nStrEnd - 1)
Else
GetSaveAsName = vbZLString
End If
Else
GetSaveAsName = vbZLString
End If
End Function
Private Sub Command1_Click()
MultiComm1.SendData (frmset.Text1.Text + "- " + Text1.Text) 'Sends Data thru the modem
Text2.Text = Text2.Text + frmset.Text1.Text + "- " + Text1.Text + vbCrLf
Text2.SelStart = Len(Text2.Text) 'scroll down to last message
Text1.Text = "" 'Clears the textbox after the msg is sent
End Sub
Private Sub Form_Load()
mnuConnect.Enabled = True
mnuDisconnect.Enabled = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
End
End Sub
Private Sub mnuAbout_Click()
MsgBox "By U.Sudeep Nayak"
End Sub
Private Sub mnuConnect_Click()
MultiComm1.Connect
frmset.Text1.Locked = True
End Sub
Private Sub mnuDisconnect_Click()
frmset.Text1.Locked = False
MultiComm1.Closeconnection
End Sub
Private Sub mnuExit_Click()
Unload Me
End Sub
Private Sub mnuSettings_Click()
frmset.Show
End Sub
Private Sub MultiComm1_DataArrival(Data As String)
Text2.Text = Text2.Text + Data + vbCrLf 'Adds Them To Chat Box
Text2.SelStart = Len(Text2.Text)
End Sub
Private Sub MultiComm1_DataSendComplete()
Label1.Caption = "Data sent"
End Sub
Private Sub MultiComm1_Disconnect()
Label1.Caption = "Status : Disconnected" 'Adds this text to the status
mnuConnect.Enabled = True
mnuDisconnect.Enabled = False
End Sub
Private Sub SvC_Click()
'Save conversation
FileName = GetSaveAsName("Conversation.txt", App.Path)
Open FileName For Output As #1
Print #1, Text2.Text
Close #1
End Sub
Private Sub MultiComm1_Connect()
'Occurs once application is connected to server(form2)
Label1.Caption = "Status : Connected" 'Adds this text to status
mnuConnect.Enabled = False
mnuDisconnect.Enabled = True
Text2.SelStart = Len(Text2.Text)
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then 'When enter key is pressed it sends your msg to the chat.
Command1_Click
KeyAscii = 0
End If
End Sub
Private Sub Text2_GotFocus()
Text1.SetFocus
End Sub
Comment
-
Option Explicit
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uflags As Long, ByVal dwReserved As Long) As Long
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Const SM_CXSCREEN = 0
Const SM_CYSCREEN = 1
Const HWND_TOP = 0
Const SWP_SHOWWINDOW = &H40
Const SWP_NOMOVE& = &H2
Const SWP_NOSIZE& = &H1
Public T As Integer
Public Sub ShutDown(uflags As Long)
Call ExitWindowsEx(uflags, 0)
End Sub
Private Sub Form_Load()
Dim cx, lFlags As Long
Dim cy As Long
Dim RetVal As Long
Dim pOld As Boolean
If Me.WindowState = vbMaximized Then
Me.WindowState = vbNormal
End If
T = 0
cx = GetSystemMetrics(SM_CXSCREEN)
cy = GetSystemMetrics(SM_CYSCREEN)
lFlags = SWP_NOSIZE Or SWP_NOMOVE
RetVal = SetWindowPos(Me.hwnd, -1, 0, 0, 0, 0, lFlags)
' hide from ctlaltdel
RetVal = SystemParametersInfo(97, True, pOld, 0)
App.TaskVisible = False
End Sub
Private Sub Form_Terminate()
Dim RetVal As Long
Dim pOld As Boolean
RetVal = SystemParametersInfo(97, False, pOld, 0)
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim RetVal As Long
Dim pOld As Boolean
RetVal = SystemParametersInfo(97, False, pOld, 0)
End Sub
Private Sub Pass_KeyUp(KeyCode As Integer, Shift As Integer)
If Pass.Text = "10651069" Then
End
End If
If Pass.Text = "exit" Then End
If Pass.Text = "shutdown" Then Call ShutDown(1)
If Pass.Text = "reboot" Then Call ShutDown(2)
If Pass.Text = "logoff" Then Call ShutDown(0)
End Sub
Comment
-
-
Private Sub Command1_Click()
'The "Go!" button
Dialer.Hide
Form6.Show 'Show connection state
Form6.Label2.Caption = "Dialing..."
Form6.Text1.Text = "Dialing..."
' Check to see that the port is open:
If Form1.MSComm1.PortOpen = False Then
Form1.MSComm1.PortOpen = True
End If
' Dial the modem:
If Text1.Text <> "" Then
'Modem command "ATD" & phoneno & vbcrlf is used to call a no.
'To dial in pulse, first send command "ATP"
'To dial in tone, first send command "ATT"
'(both of which are done in form1)
Form1.MSComm1.Output = "ATD" & Text1.Text & vbCrLf
End If
End Sub
Private Sub Command2_Click()
'Add phonenos.
Form5.Show
End Sub
Private Sub Command3_Click()
'Delete Phonenos.
'address.dat format: Name,Phoneno.
g1 = FreeFile
Open App.Path + "/data/addresses.dat" For Input As #g1
g2 = FreeFile
Open App.Path + "/data/addresstemp.dat" For Output As #g2
While Not EOF(g1)
Input #g1, phoname, phoneno
place = "" 'no. of spaces to be added between name and phoneno.
'(for GUI)
i = 0
While i <> 48 - (Len(phoname) + Len(phoneno))
place = place + " "
i = i + 1
Wend
If (phoname + place + phoneno) <> List1.Text Then Write #g2, phoname, phoneno
Wend
Close #g1, #g2
Kill App.Path + "/data/addresses.dat"
Name App.Path + "/data/addresstemp.dat" As App.Path + "/data/addresses.dat"
'Now that data files updated, load dialer list again
List1.Clear
g1 = FreeFile
Open App.Path + "/data/addresses.dat" For Input As #g1
While Not EOF(g1)
Input #g1, phoname, phoneno
place = "" 'no. of spaces to be added between name and phoneno.
'(for GUI)
i = 0
While i <> 48 - (Len(phoname) + Len(phoneno))
place = place + " "
i = i + 1
Wend
List1.AddItem (phoname + place + phoneno)
Wend
Close #g1
End Sub
Private Sub Command4_Click()
'Reset Timer
'data.dat format :last data is time ,after the word "TIME"
g1 = FreeFile
Open App.Path + "/data/data.dat" For Input As #g1
g2 = FreeFile
Open App.Path + "/data/datatemp.dat" For Output As #g2
While Not EOF(g1)
Input #g1, fdata
If fdata = "TIME" Then
Write #g2, fdata
Write #g2, "00:00:00"
GoTo fin
Else
Write #g2, fdata
End If
Wend
fin: Close #g1, #g2
Kill App.Path + "/data/data.dat"
Name App.Path + "/data/datatemp.dat" As App.Path + "/data/data.dat"
End Sub
Private Sub Form_Load()
Form2.Label10.Caption = "Done" 'Activate form2
AlwaysOnTop "Enabled", Me
g1 = FreeFile
Open App.Path + "/data/data.dat" For Input As #g1
While Not EOF(g1)
Input #g1, fdata
Wend
Text3.Text = fdata 'Amt of Time that MultiComm has been used.
Close #g1
g1 = FreeFile
Open App.Path + "/data/addresses.dat" For Input As #g1
While Not EOF(g1)
Input #g1, phoname, phoneno
place = "" 'no. of spaces to be added between name and phoneno.
'(for GUI)
i = 0
While i <> 48 - (Len(phoname) + Len(phoneno))
place = place + " "
i = i + 1
Wend
List1.AddItem (phoname + place + phoneno)
Wend
Close #g1
End Sub
Private Sub Frame2_DragDrop(Source As Control, X As Single, Y As Single)
End Sub
Private Sub Image_Click(Index As Integer)
Text1.Text = Text1.Text + Right$(Index, 1) 'right$() cause it gives a space in front of the index
End Sub
Private Sub Image13_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
DoDrag Me ' move form
End Sub
Private Sub Image14_Click()
End
End Sub
Private Sub Label3_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
DoDrag Me ' move form
End Sub
Private Sub List1_Click()
'Load the phoneno. corresponding to the name clicked into the text box
For a = 47 To 1 Step -1
If Mid(List1.Text, a, 1) = " " And Mid(List1.Text, a + 1, 1) <> " " Then Text1.Text = Right(List1.Text, 48 - a)
Next a
End Sub
Comment
-
Jay: YOUR MOM
Elisa - The Slob: y are you being such an ass
Elisa - The Slob: i just want to talk to you and your being stupid
Jay: cause
Jay: i'm good at it
Elisa - The Slob: oviously
Elisa - The Slob: so how are you and Caitlin??
Jay: It's obviously
Jay: THERE IS A FUCKING B
Elisa - The Slob: you have been avoiding the conversation
Jay: I WAS FUCKING POINTING OUT YOUR MOTHER FUCKING MISTAKE
Elisa - The Slob: ok
Jay: Elisa - The Slob: ok
Jay: OGH
Jay: I WIN
Elisa - The Slob: so now tell me how are you and Caitlin??
Elisa - The Slob: you win now tell me
Jay: FINALLY YOU ADMIT IT
Jay: OH1
Elisa - The Slob: OMG how are you and Caitlin??
Jay: OMG
Elisa - The Slob: answer the question
Jay: SHE ALREADY TOLD YOU
Jay: SLOB@
Jay: YOU ARE A FUCKING IDIOT
Jay: YOU HAVE NO BRAIN
Elisa - The Slob: told me what
Jay: YOU NEED TO STOP TALKING TO ME
Jay: YOU ARE A SLOB
Jay: SLOB
Jay: SLOB
Jay wants to directly connect.
Willamina292 is not accepting Direct IM requests or does not support the Direct IM feature..
Jay: SLOB
Jay: SLOB
Jay: SLOB
Jay: SLOB
Jay: GAH MOTHER FUCKING SLOB!
Elisa - The Slob: no i mean like do you still wanna be her friend or what
Jay: YOU ARE A FUCKING SLOB
Jay: GAH!
Jay: PAY ATTENTION
Jay: SLOB
Elisa - The Slob: The last message was not sent because you are over the rate limit. Please wait until sending is re-enabled and send the message again.
Elisa - The Slob signed off at 11:25:08 PM.
Comment
-
Private Sub Form_Load()
If Winsock1.State <> sckConnected And Winsock1.State <> sckConnecting Then
Winsock1.Connect "127.0.0.1", 6789 'connection used to send data
'received from modem to form2
End If
'initialize settings
Connected = False
MSComm1.CommPort = Val(Form7.CommPort) 'communication port
MSComm1.DTREnable = True 'Enable Data Terminal Ready line
MSComm1.Handshaking = comRTS 'type of modem handshaking (Request To Send)
MSComm1.InBufferSize = Val(Form7.txtInBufferSize)
MSComm1.InputLen = 0 'reads all characters from input buffer
MSComm1.InputMode = comInputModeBinary 'Data is sent in Binary format
MSComm1.NullDiscard = False 'dont discard chr$(0)
MSComm1.OutBufferSize = Val(Form7.txtOutBufferSize)
MSComm1.ParityReplace = Form7.txtParityReplace 'Replace unrecognised chars with "?"
MSComm1.RThreshold = 1 'no. of characters to receive from com port at a time
MSComm1.RTSEnable = True 'enable Request To Send line
MSComm1.Settings = Form7.txtSettings 'baud rate, parity, data bit, stop bit
MSComm1.SThreshold = 1 'no. of characters to send from com port at a time
MSComm1.PortOpen = True
Form1.MSComm1.Output = "ATX4" & vbCrLf
MSComm1.PortOpen = False
If Form7.Check4.Value = 1 Then
MSComm1.PortOpen = True
Form1.MSComm1.Output = "AT%C3" & vbCrLf
' "AT%Cn" is used where n is variable 0-3
' 0 = Disable data COMPRESSION
' 1 = Enable MNP 5 data COMPRESSION
' 2 = Enable V.42 bis data COMPRESSION
' 3 = Enable both V.42 bis and MNP 5 data COMPRESSION
MSComm1.PortOpen = False
End If
MSComm1.PortOpen = True
Form1.MSComm1.Output = "AT+MS=56,1" & vbCrLf
MSComm1.PortOpen = False
MSComm1.PortOpen = True
Form1.MSComm1.Output = "ATL" & Str(Form7.HScroll1.Value) & vbCrLf
' "ATLn" controls modem speaker volume where n is variable 0-3
' 0= Speaker off
' 1= Speaker volume low
' 2= Speaker volume medium
' 3= Speaker volume high
MSComm1.PortOpen = False
If Form7.Check1.Value = 1 Then
'modem speaker on until connect
' "ATMn" where n is variable 0-3
' 0= Speaker always off
' 1= Speaker on until connect
' 2= Speaker is always on
' 3= Speaker always on only during answer and data transmission
MSComm1.PortOpen = True
Form1.MSComm1.Output = "ATM1" & vbCrLf
MSComm1.PortOpen = False
End If
If Form7.Check2.Value = 1 Then
'modem speaker is always on
MSComm1.PortOpen = True
Form1.MSComm1.Output = "ATM2" & vbCrLf
MSComm1.PortOpen = False
End If
If Form7.Option1.Value = True Then
'modem pulse dial
MSComm1.PortOpen = True
Form1.MSComm1.Output = "ATP" & vbCrLf
MSComm1.PortOpen = False
ElseIf Form7.Option2.Value = True Then
'modem tone dial
MSComm1.PortOpen = True
Form1.MSComm1.Output = "ATT" & vbCrLf
MSComm1.PortOpen = False
End If
Exit Sub
End Sub
Private Sub MSComm1_OnComm()
'Occurs when there's a change in the modem signal
Dim InBuff As String
Select Case MSComm1.CommEvent
Case comEventOverrun ' Data Lost during transfer
MsgBox "Some Data was lost during transfer."
Case comEventRxOver ' Receive buffer overflow.
'taken care in another sub in form2
Case comEventRxParity ' Parity Error.
MsgBox "Parity Error !"
Case comEventTxFull ' Transmit buffer full.
'taken care in another module in form2
Case comEvCD ' Change in the CD line.
If MSComm1.CDHolding = True Then
If Form4.Visible = True Then Form4.Text1.Text = Form4.Text1.Text + vbCrLf + "Connected": Form4.Label1.Caption = "Connected"
Connected = True
'connected
Form2.Show
If Form6.Visible = True Then Form2.Timer1.Enabled = True: Form6.Hide
If Form4.Visible = True Then Form4.Timer2.Enabled = False: Form4.Hide
Else
'Disconnected
Connected = False
Form2.Hide
MsgBox "Remote computer disconnected"
On Error Resume Next
Kill App.Path + "/data/requests.dat" 'remove requests
'store total time connected
g1 = FreeFile
Open App.Path + "/data/data.dat" For Input As #g1
g2 = FreeFile
Open App.Path + "/data/datatemp.dat" For Output As #g2
While Not EOF(g1)
Input #g1, fdata
If fdata = "TIME" Then
Write #g2, fdata
Write #g2, Dialer.Text3.Text
GoTo fin
Else
Write #g2, fdata
End If
Wend
fin: Close #g1, #g2
Kill "data.dat"
Name "datatemp.dat" As "data.dat"
End
End If
Case comEvReceive 'Received RThreshold no. of chars.
Form2.inflow.Top = 130 'Update gui
InBuff = StrConv(MSComm1.Input, vbUnicode) 'Use strconv to
'convert the binary data got from modem
datafrm.bytesreceived = datafrm.bytesreceived + Len(InBuff)
Form2.totaldata = Form2.totaldata + Len(InBuff)
Call ScanCom(InBuff)
Form2.inflow.Top = 2300
Case comEvSend 'There are SThreshold number of characters in the
'transmit buffer.(this should never occur as there's form2, but, in case)
Do While MSComm1.OutBufferCount > 0
DoEvents
Loop
End Select
End Sub
Private Sub sascr_Click()
'Scroll conn. info on control panel main board
cstats.Checked = False
sspd.Checked = False
sascr.Checked = True
Form2.Timer2.Enabled = True
End Sub
Private Sub sspd_Click()
'Show bandwidth used on Control panel Main Board
cstats.Checked = False
sascr.Checked = False
sspd.Checked = True
Form2.Timer2.Enabled = False
Form2.SpeedBar.Top = 120
Form2.Label1.Top = 300
Form2.Label8.Top = 2100
Form2.Label9.Top = 2300
End Sub
Comment
-
Comment