'Gunumuzun populer chat,paylaşım vs. programı ICQ'dan hepimiz pager almışızdır.
'Bu makale ile bundan sonra istediğimiz icq numarasına pager �gonderebileceğiz.
'Oncelikler Pager da şu bilgiler bulunur.
'1.ICQ No
'2.Gonderenin ismi
'3.Gonderenin e-mail adresi
'4.Pager konusu
'5.Mesaj
'Program ile bu değerler teker teker okunacak ve icq serverına yollanacak.
'Program icin yukardakiler goz onunde tutularak;
'5 tane TextBox 1 CommandButton ve WinSock
'Text1
agerın gideceği icqno,Text2:kimden gonderildiği,'Text3:gonderenin mail adresi,Text4:konu baslığı,Text5:Mesaj
Option Explicit
Dim Mesaj As String
Dim Konu As String
Dim Kimden As String
Dim EMail As String
Private Function BoslukKontrol(HangiString As String) As String
'Bu Fonksiyon String de Bulunan Boslukları + ile Degistirir.
'Pager Gonderirken Bosluk Yerine + Karakteri Kullanılır...
On Error Resume Next
Dim KaRaKTeR As String
Dim GeCiCi As String
Dim i As Long
KaRaKTeR = ""
For i = 1 To Len(HangiString)
KaRaKTeR = Mid(HangiString, i, 1)
If KaRaKTeR = " " Then
KaRaKTeR = "+"
End If
GeCiCi = GeCiCi + KaRaKTeR
Next
BoslukKontrol = GeCiCi
End Function
Private Sub Pager_Connect()
'Baglandıgında Bilgiyi Gondermeye Başlar Ve Mesaj Verir...
pager.SendData pager.Tag
MsgBox "Servise Bağlanıldı.Pager Gonderiliyor..."
End Sub
Private Sub Pager_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)
'Hata Durumunda WinSock Kapatılır Ve Hata Mesajı Verilir.
MsgBox "Hata Oluştu..."
pager.Tag = ""
pager.Close
End Sub
Private Sub Pager_SendComplete()
'Pager Gonderimi Bittigi Zaman Bir Mesaj ile Bildirilir.
MsgBox "Pager Gonderildi..."
pager.Tag = ""
End Sub
Private Sub Command1_Click()'Pager Olusturulup Gonderiliyor...
On Error Resume Next
Dim Gonder As String
Dim Bilgi As String
pager.Close
'Bosluklar Degistiriliyor...
Konu = BoslukKontrol(Text4.Text)
Mesaj = BoslukKontrol(Text5.Text)
Kimden = BoslukKontrol(Text2.Text)
EMail = BoslukKontrol(Text3.Text)
'Burada Yapılacak Herhangi Bir Değişiklik Pagerın Gitmemesine Yolacacaktır.
Bilgi = "from=" & Kimden & "&fromemail=" & EMail & "&subject=" & Konu & "&body=" & Mesaj & "&to=" & Trim(Text1.Text) & "&Send=" & """"
'Winsock ile Mirabilis Servisine Bağlanılır.WWPMsg.dll Kullanılıarak
'Aşağıdaki Bilgiler Gonderilerek Page Gonderilmiş Olur...
Gonder = "POST /scripts/WWPMsg.dll HTTP/1.0" & vbCrLf
Gonder = Gonder & "Referer: http://wwp.mirabilis.com" & vbCrLf
Gonder = Gonder & "User-Agent: Mozilla/4.06 (Win95; I)" & vbCrLf
Gonder = Gonder & "Connection: Keep-Alive" & vbCrLf
Gonder = Gonder & "Host: wwp.mirabilis.com:80" & vbCrLf
Gonder = Gonder & "Content-type: application/x-www-form-urlencoded" & vbCrLf
Gonder = Gonder & "Content-length: " & Len(Bilgi) & vbCrLf
Gonder = Gonder & "Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, */*" & vbCrLf & vbCrLf
Gonder = Gonder & Bilgi & vbCrLf & vbCrLf & vbCrLf & vbCrLf
pager.Tag = Gonder
pager.Connect "wwp.mirabilis.com", 80 'Mirabilise Bağlanılıyor...
End Sub
__________________