Il CD di internet/CD.iso/INTERNET/USENET/PAPERBOY/SOURCE.ZIP/FRMMAIL.FRM

Visual Basic Form | 1994-10-02 | 6.4 KB | 203 lines

VERSION 2.00
Begin Form frmmail
   BackColor       =   &H00C0C0C0&
   Caption         =   "Send Email"
   ClientHeight    =   5304
   ClientLeft      =   2088
   ClientTop       =   2400
   ClientWidth     =   6084
   Height          =   5724
   Left            =   2040
   LinkTopic       =   "Form1"
   MinButton       =   0   'False
   ScaleHeight     =   5304
   ScaleWidth      =   6084
   Top             =   2028
   Width           =   6180
   Begin CommandButton cmdcancel
      Caption         =   "&Cancel"
      Height          =   372
      Left            =   2760
      TabIndex        =   6
      Top             =   4800
      Width           =   972
   End
   Begin CommandButton cmdsend
      Caption         =   "&Send"
      Enabled         =   0   'False
      Height          =   372
      Left            =   1080
      TabIndex        =   5
      Top             =   4800
      Width           =   972
   End
   Begin TextBox txtmsg
      Height          =   3252
      Left            =   120
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   4
      Top             =   1320
      Width           =   5292
   End
   Begin TextBox txtsubj
      BorderStyle     =   0  'None
      Height          =   372
      Left            =   1200
      TabIndex        =   3
      Top             =   720
      Width           =   3852
   End
   Begin TextBox txtto
      BorderStyle     =   0  'None
      Height          =   372
      Left            =   1200
      TabIndex        =   2
      Top             =   120
      Width           =   3852
   End
   Begin Label Label2
      BackColor       =   &H00C0C0C0&
      Caption         =   "Subject:"
      DataField       =   "Subject:"
      Height          =   372
      Left            =   120
      TabIndex        =   0
      Top             =   720
      Width           =   1092
   End
   Begin Label Label1
      BackColor       =   &H00C0C0C0&
      Caption         =   "To:"
      Height          =   372
      Left            =   120
      TabIndex        =   1
      Top             =   120
      Width           =   1092
   End
Option Explicit
Sub cmdcancel_Click ()
Dim result As Integer
    If Len(txtmsg.Text) > 0 Then
        result = MsgBox("You will lose any text you entered." + Chr(10) + "Are you sure?", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2, "Abort message?")
        If result = IDYES Then Unload frmmail
    Else
        Unload frmmail
    End If
End Sub
Sub cmdsend_Click ()
Dim uniq As Integer, result As Integer
Dim fout As Integer
Dim fname As String
Dim ptr, column As Integer
Dim msg As String
Dim replyto, organization As String
    msg = txtmsg.Text
' Get a unique filename (PBR00N.MSG)
    uniq = Val(GetINI("Message", "LastMessage", "1"))
    uniq = uniq + 1
    SetINI "Message", "LastMessage", Format$(uniq)
    If replytype = 1 Then
        fname = app.Path + "\PBM" + Format$(uniq, "000") + ".MSG"
    Else
        fname = app.Path + "\PBN" + Format$(uniq, "000") + ".MSG"
    End If
    fout = FreeFile
    Open fname For Output As fout
' Do headers
    If replytype = 1 Then
        Print #fout, "To: " + txtto.Text
    Else
        Print #fout, "Newsgroups: " + txtto.Text
    End If
    Print #fout, "Subject: " + txtsubj.Text
    If UCase$(GetINI("Message", "PostDate", "Y")) = "Y" Then Print #fout, "Date: " + fixstr(GetGMTime())
    If mailreferences <> "" Then Print #fout, "References: " + mailreferences
' Optional Reply-To
    replyto = GetINI("Message", "Reply-To", "")
    If Len(replyto) > 2 Then Print #fout, "Reply-To: " + replyto
' Optional Organization
    organization = GetINI("Message", "Organization", "")
    If Len(organization) > 2 Then Print #fout, "Organization: " + organization
' Dump message to a file
    Print #fout,    ' Blank line seperates headers from message
    For ptr = 1 To Len(msg)
        column = column + 1
        If column > 70 And Mid$(msg, ptr, 1) = " " Then
        ' Wrap line
            Print #fout,
            column = 0
        Else
            Print #fout, Mid$(msg, ptr, 1);
        End If
    Next ptr
    Close fout
    result = Post(fname, replytype) 'post mail or news
    ' Ask about editing again?
    Unload frmmail
End Sub
Sub Form_Load ()
Dim sigfname As String
Dim sigout As Integer
Dim sigline As String
    frmmail.Width = frmmain.Width * .8
    frmmail.Height = frmmain.Height * .8
    frmmail.Left = (screen.Width - frmmail.Width) / 2
    frmmail.Top = (screen.Height - frmmail.Height) / 2
    txtsubj = mailsubject
    txtto = mailsendto
    Form_resize
    If replytype = 1 Then
        label1.Caption = "To:"
        frmmail.Caption = "Send Email"
        cmdsend.Caption = "&Send"
    Else
        label1.Caption = "Newsgroup:"
        frmmail.Caption = "Post News"
        cmdsend.Caption = "&Post"
    End If
    ' Do signature
    sigfname = GetINI("Message", "Signature-File", app.Path + "\SIG.TXT")
    If FileExists(sigfname) Then
        sigout = FreeFile
        Open sigfname For Input As sigout
        txtmsg.Text = txtmsg.Text + Chr(13) + Chr(10) + "-- " + Chr(13) + Chr(10)
        While Not EOF(sigout)
            Line Input #sigout, sigline
            txtmsg.Text = txtmsg.Text + sigline + Chr(13) + Chr(10)
        Wend
        Close sigout
        Else
            ' Default signature ?
    End If
End Sub
Sub Form_Paint ()
    If txtto = "" Then
        txtto.SetFocus
    ElseIf txtsubj = "" Then
        txtsubj.SetFocus
    Else
        txtmsg.SetFocus
    End If
End Sub
Sub Form_resize ()
    txtto.Width = frmmail.ScaleWidth - txtto.Left - 50
    txtmsg.Width = frmmail.ScaleWidth - txtmsg.Left * 2
    txtsubj.Width = txtto.Width
    cmdcancel.Top = frmmail.ScaleHeight - cmdsend.Height
    cmdsend.Top = cmdcancel.Top
    txtmsg.Height = cmdcancel.Top - txtmsg.Top
End Sub
Sub test ()
Dim x As Integer
Dim z As Integer
       x = Shell("notepad.exe") ' Modify path as needed.
       While GetModuleUsage(x) > 0    ' Has Shelled program finished?
          z = DoEvents()              ' If not, yield to Windows.
       Wend
       MsgBox "Shelled application just terminated", 64
End Sub
Sub txtto_Change ()
    If Len(Trim(txtto.Text)) > 0 Then cmdsend.Enabled = True Else cmdsend.Enabled = False
End Sub