برنامج الارسال المباشر بالأكسس مفتوح

السلام عليكم ورحمة الله وبركاته

إخواني الكرم ...... لقد وضعت موضوعا باسم على هذا الرابط هنااااااا بعنوان ارسال بريد بالاكسس مباشر

http://www.arabteam2000forum.com/index.php?showtopic=117476-

والموضوع ماهو الا تجربة وبعد تأكدي من نجاح التجربة يسرني أن أضع لكم البرنامج بالكود في هذه المشاركة

البرنامج يستعمل وسيط بواسطة لغة php حيث تنشيء الملف التالي وترفعه لسيرفر يدعم ملفات php وتكتب فيه الشفرة التالية مع تغيير مايلزم

<html>
<?
			$ekseer .= "Importance: High\n";
			$ekseer .= "X-MSMail-Priority: High\n";
			$ekseer .= "X-Mailer: ekser Mailler With access & PHP!\n";
			$ekseer  = "MIME-Version: 1.0\r\n";
			$ekseer .= "X-Priority: 1\r\n";
			$ekseer .= "From:ekser Send mail <$emailfrom>\r\n";

mail($emailto, $subject, $message, $ekseer);

?>
</html>

ثم تعمل ربط بين برنامجك وملف php تحديد المسار في البرنامج بكل دقة واليكم شفرة البرنامج

يوضع هذا الكود في القسم العام الجنيرال

Public emailto As String, subject As String, message As String, emailfrom As String, url As String

وهذه الوظيفة خاصة بتحديد حالة الاتصال

Public Function IsConnected() As Boolean

	Dim TRasCon(255) As RASCONN95
	Dim lg As Long
	Dim lpcon As Long
	Dim RetVal As Long
	Dim Tstatus As RASCONNSTATUS95

	TRasCon(0).dwSize = 412
	lg = 256 * TRasCon(0).dwSize

	RetVal = RasEnumConnections(TRasCon(0), lg, lpcon)

	If RetVal <> 0 Then
		MsgBox "ERROR"
		Exit Function
	End If

	Tstatus.dwSize = 160
	RetVal = RasGetConnectStatus(TRasCon(0).hRasCon, Tstatus)

	If Tstatus.RasConnState = &H2000 Then
		IsConnected = True
	Else
		IsConnected = False
	End If

End Function

وهذا الامر في حدث تحميل الفورم

	If IsConnected() = True Then
	Me.أمر27.Caption = "Online"
	Else
	 Me.أمر27.Caption = "Offline"
	End If

وهذا الامر في حدث النقر للكوماند ارسال لاحظ بدقة الارتباط بين الفايل php وكود الارسال

 On Error GoTo errsub
  emailto = emailto = "هنا تضع بريد المرسل اليه"
  emailfrom = Me.txtfrom
  subject = Me.txtsub
  message = Me.txtmsg
url = "هنا الرابط الكامل لملف الاسكربت السابق" & "emailto=" & emailto & "&emailfrom=" & emailfrom & "&subject=" & subject & "&message=" & message
Me.txturl = url

  Inet9.OpenURL (url)
  MsgBox "رسالتك أرسلت:" & vbNewLine & "إلى:" & emailto, vbOKOnly, "تم الارسال بنجاح"
errsub:
If Err.Number = 94 Then
   MsgBox "يجب ملء جميع الحقول", 64, "Errsub mail"
End If

وهذا الحدث عند النقر على حدث كوماند تحديد حالة الاتصال

If Me.أمر27.Caption = "Online" Then
   MsgBox "أنت متصل بالإنترنت ويمكنك الإرسال من البرنامج", 64, "Online"
Else
   MsgBox "أنت غير متصل بالإنترنت .. الاتصال الفضائي لايظهر", 64, "Offline"
End If

وهذا المودويل خاص بتحديد حالة الاتصال خاص بالمودم فقط

Public Declare Function RasEnumConnections Lib "RasApi32.dll" Alias _
	"RasEnumConnectionsA" (lpRasCon As Any, lpcb As Long, _
	lpcConnections As Long) As Long
Public Declare Function RasGetConnectStatus Lib "RasApi32.dll" Alias _
	"RasGetConnectStatusA" (ByVal hRasCon As Long, lpStatus As Any) As Long
Public Const RAS95_MaxEntryName = 256
Public Const RAS95_MaxDeviceType = 16
Public Const RAS95_MaxDeviceName = 32

Public Type RASCONN95
dwSize As Long
hRasCon As Long
szEntryName(RAS95_MaxEntryName) As Byte
szDeviceType(RAS95_MaxDeviceType) As Byte
szDeviceName(RAS95_MaxDeviceName) As Byte
End Type

Public Type RASCONNSTATUS95
dwSize As Long
RasConnState As Long
dwError As Long
szDeviceType(RAS95_MaxDeviceType) As Byte
szDeviceName(RAS95_MaxDeviceName) As Byte
End Type

ملاحظات هامة جدا

1- تضيف على الفورم عنصر تحكم اكتف اكس Msinet.ocx موجود مع المرفق لمن لايوجد لديه ويوجد ضمن عناصر الاكتف اكس باسم

microsoft internet Transfer control 6.0

ستلاحظه على الفورم في المثال باسم Inet9

أنتهى راجيا ابدأ ملاحظاتكم للإرتقاء بعمل الكود وجاري العمل لجعل البرنامج يرسل لأكثر من بريد من قاعدة البيانات والله يرعاكم

الملف مرفق يشمل البرنامج مفتوح المصدر مع فايل php تقبلوا تحياتي

Ekseer

عفوا نسيت المرفقات

تحياتي

send_mail_accees.rar