www.pudn.com > FaxAutomation.zip > ATLASCOM.frm, change:2001-11-08,size:8402b


VERSION 5.00 
Begin VB.Form ATLASCOM  
   AutoRedraw      =   -1  'True 
   BackColor       =   &H008080FF& 
   BorderStyle     =   1  'Fixed Single 
   Caption         =   "                                   ATLASCOM  - Auto-FAX System -  (c) 2001" 
   ClientHeight    =   8100 
   ClientLeft      =   45 
   ClientTop       =   330 
   ClientWidth     =   7575 
   FillColor       =   &H00C0C000& 
   ForeColor       =   &H00FFFF00& 
   Icon            =   "ATLASCOM.frx":0000 
   LinkTopic       =   "Form1" 
   MaxButton       =   0   'False 
   MinButton       =   0   'False 
   ScaleHeight     =   8100 
   ScaleWidth      =   7575 
   StartUpPosition =   3  'Windows Default 
   Begin VB.PictureBox Picture1  
      Height          =   1335 
      Left            =   600 
      Picture         =   "ATLASCOM.frx":030A 
      ScaleHeight     =   1275 
      ScaleWidth      =   6315 
      TabIndex        =   11 
      Top             =   120 
      Width           =   6375 
   End 
   Begin VB.FileListBox File1  
      BackColor       =   &H00C0E0FF& 
      BeginProperty Font  
         Name            =   "Arial" 
         Size            =   9.75 
         Charset         =   161 
         Weight          =   400 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
      ForeColor       =   &H00C00000& 
      Height          =   3450 
      Left            =   3600 
      TabIndex        =   10 
      Top             =   3480 
      Width           =   3495 
   End 
   Begin VB.DirListBox Dir1  
      Height          =   3015 
      Left            =   480 
      TabIndex        =   9 
      Top             =   3840 
      Width           =   3015 
   End 
   Begin VB.DriveListBox Drive1  
      Height          =   315 
      Left            =   480 
      TabIndex        =   8 
      Top             =   3480 
      Width           =   3015 
   End 
   Begin VB.TextBox Text3  
      BackColor       =   &H00FFFFC0& 
      Height          =   285 
      Left            =   1080 
      OLEDropMode     =   1  'Manual 
      TabIndex        =   4 
      Top             =   3120 
      Width           =   5535 
   End 
   Begin VB.TextBox Text2  
      Height          =   285 
      Left            =   3720 
      Locked          =   -1  'True 
      TabIndex        =   3 
      Top             =   2280 
      Width           =   2295 
   End 
   Begin VB.CommandButton Command2  
      BackColor       =   &H008080FF& 
      Caption         =   "QUIT" 
      Default         =   -1  'True 
      Height          =   735 
      Left            =   480 
      MaskColor       =   &H00C0C0FF& 
      Style           =   1  'Graphical 
      TabIndex        =   2 
      Top             =   7200 
      UseMaskColor    =   -1  'True 
      Width           =   735 
   End 
   Begin VB.TextBox Text1  
      Height          =   285 
      Left            =   3720 
      OLEDropMode     =   1  'Manual 
      TabIndex        =   1 
      Top             =   1800 
      Width           =   2295 
   End 
   Begin VB.CommandButton Command1  
      BackColor       =   &H0080FF80& 
      Caption         =   "Send Fax" 
      BeginProperty Font  
         Name            =   "Comic Sans MS" 
         Size            =   12 
         Charset         =   161 
         Weight          =   400 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
      Height          =   735 
      Left            =   5040 
      MaskColor       =   &H00FF8080& 
      Style           =   1  'Graphical 
      TabIndex        =   0 
      Top             =   7200 
      Width           =   2055 
   End 
   Begin VB.Label Label3  
      Alignment       =   2  'Center 
      BackColor       =   &H00FFC0C0& 
      BorderStyle     =   1  'Fixed Single 
      Caption         =   "File to be sended as FAX" 
      Height          =   255 
      Left            =   1080 
      TabIndex        =   7 
      Top             =   2760 
      Width           =   5535 
   End 
   Begin VB.Label Label2  
      Alignment       =   2  'Center 
      BackColor       =   &H00FFC0C0& 
      BorderStyle     =   1  'Fixed Single 
      Caption         =   "Recipient" 
      Height          =   255 
      Left            =   1800 
      TabIndex        =   6 
      Top             =   2280 
      Width           =   1455 
   End 
   Begin VB.Label Label1  
      Alignment       =   2  'Center 
      BackColor       =   &H00FFC0C0& 
      BorderStyle     =   1  'Fixed Single 
      Caption         =   "FAX number" 
      Height          =   255 
      Left            =   1800 
      TabIndex        =   5 
      Top             =   1800 
      Width           =   1455 
   End 
End 
Attribute VB_Name = "ATLASCOM" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
Private Sub Form_Load() 
 
'WIN-2000 FaxService must have been installed and set to automatic at 
'startup. A FAX modem must be connected to the serial port. 
 
'Another application may have put a string of the form "nnnnnnnnnn#*#Dave Cutler", 
'in the clip-board. The application will get it and will 
'present the Fax_Num (nnnnnnnnnn) & the Recepient's Name in the respected 
'boxes for visual check. If this string does not exist, a MsgBox appears. 
'DOC's TXT's XLS's and other formats are supported 
'Take care to check all the needed strings (host_name e.t.c.) 
'jopil@atlascom.gr // Please send comments or suggestions. 
 
Dim FaxInfo As String, FaxNumber As String, FaxName As String 
 
 
FaxInfo = Clipboard.GetText 
If InStr(FaxInfo, "#*#") = 0 Then 
   If InStr(FaxInfo, "ABORT") = 0 Then 
      MsgBox "FAX Number does not exist.", vbOKOnly, "FAX Notification System" 
   Else 
      MsgBox "FAX Operation aborted.", vbOKOnly, "FAX Notification System" 
      End 
   End If 
Else 
   FaxNumber = Left(FaxInfo, InStr(1, FaxInfo, "#*#") - 1) 
   FaxName = Mid(FaxInfo, InStr(1, FaxInfo, "#*#") + 3) 
End If 
 
   Text1.Text = FaxNumber 
   Text2.Text = FaxName 
   Text3.Text = "Here goes the document's Full Path & Name" 
 
 
 
 
End Sub 
Private Sub Command1_Click() 
 
 
Dim FaxServer As Object 
Dim FaxDocument As Object 
 
On Error GoTo message 
 
If Len(Trim(Text1.Text)) = 0 Or _ 
   Len(Trim(Text1.Text)) < 10 Or _ 
   Not IsNumeric(Text1.Text) Then 
        MsgBox "FAX Number not acceptable. Can not send", vbOKOnly, "ERROR SENDING FAX" 
        GoTo donothing 
End If 
 
If Len(Trim(Text3.Text)) = 0 Then 
   MsgBox "FAX File not present. Can not send", vbOKOnly, "ERROR SENDING FAX" 
   GoTo donothing 
End If 
 
If Dir(Trim(Text3.Text)) = "" Then 
   MsgBox "FAX File not present. Can not send", vbOKOnly, "ERROR SENDING FAX" 
   End 
End If 
 
Set FaxServer = CreateObject("FaxServer.FaxServer") 
    FaxServer.Connect ("Host_Name --that hosts the win-2000 Fax_Service--") 
    FaxServer.ArchiveOutboundFaxes = 5 'queue, may be as many we want 
    FaxServer.ArchiveDirectory = "c:\Faxes_Send" 
    FaxServer.Retries = 5 
    FaxServer.RetryDelay = 1 
 
 
 
 
Set FaxDocument = FaxServer.CreateDocument(Trim(Text3.Text)) 
    FaxDocument.FaxNumber = Trim(Text1.Text) 
    FaxDocument.DisplayName = "Your Name goes here" 
    FaxDocument.FileName = Trim(Text3.Text) 
    FaxDocument.Tsid = "Your ID" 
    FaxDocument.Send 
 
 
 
Set FaxDocument = Nothing 
    FaxServer.Disconnect 
Set FaxServer = Nothing 
 
 
  
Exit Sub 
 
message: 
 
    Set FaxDocument = Nothing 
        FaxServer.Disconnect 
    Set FaxServer = Nothing 
    MsgBox "File not proper for sending as FAX", vbOK, "ERROR SENDING FAX" 
 
donothing: 
 
End Sub 
 
Private Sub Command2_Click() 
 
End 
 
End Sub 
 
 
 
Private Sub Dir1_Change() 
    ' FileListBox synchronizing with DirectoryListBox 
    File1.Path = Dir1.Path 
    File1.Refresh 
End Sub 
 
Private Sub Dir1_Click() 
 
    File1.Path = Dir1.Path 
    File1.Refresh 
 
End Sub 
 
 
Private Sub Drive1_Change() 
    ' DirectoryListBox synchronizing with DriveListBox 
    On Error GoTo eh 
    Dir1.Path = Drive1.Drive 
    Dir1.Refresh 
    Exit Sub 
eh: 
    Drive1.Drive = Dir1.Path 
    Exit Sub 
End Sub 
 
Private Sub File1_DblClick() 
 
    Text3.Text = File1.Path & "\" & File1.FileName 
 
End Sub