Stap 2: Visual Basic 6.0 (deel 1)
De tweede stap zou beginnen om te coderen de VB-programma. Ik code sommige functies als klasse zoals zou hierdoor wil dll maken. De eerste klasse zou lezen van tekstbestanden en bewaar ze in een array binnen het programma. Ik vond de code in 'Programmering Visual Basic 6.0' handleiding. Deze functie kan ik voorgeprogrammeerde commando's in het programma te laten laden.Programma-Code
Publieke functie FileToArray(ByVal filename As String) As String
Op GoTo fout
Dim items() As String, i As Integer
' Lezen van de inhoud van het bestand, en splitsen in een matrix van tekenreeksen. (Afrit hier als er een fout optreedt.)
items() = Strings.Split(ReadTextFileContents(filename), vbCrLf)
Voor i = LBound(items()) naar UBound(items())
FileToArray = FileToArray & vbCrLf & items(i)
Volgende
MsgBox "Opdrachten geladen!"
Exit Function
Fout:
MsgBox "fout in FileToArray:" & Err.Description
End Function
' Lees hele context in een bestand
Publieke functie ReadTextFileContents(filename As String) As String
Dim fnum As Integer, isOpen As Boolean
Op fout GoTo Error_Handler ' krijgen het volgende beschikbare bestandsnummer.
fnum = FreeFile()
Open filename voor Input als #fnum ' als uitvoering stroom kreeg hier, het bestand is al open foutloos.
isOpen = True ' lezen van de volledige inhoud in een enkele bewerking.
ReadTextFileContents = Input(LOF(fnum), fnum) ' opzettelijk stromen in de error handler het dossier te sluiten.
Error_Handler: ' de fout (indien aanwezig) te verhogen, maar het bestand eerst te sluiten.
Als isOpen slot #fnum
Als Err vervolgens Err.Raise Err.Number, Err.Description
End Function
_____________________________________________________________________________________________
Na dat vond ik het programma om te laden van postvak in berichten vanaf Gmail (http://www.j4mie.org/2008/02/15/how-to-make-a-physical-gmail-notifier/ ). Ik solliciteerde deze functie zodat de opdrachten van het laden van uw Gmail-inbox uit te voeren van de Light-Controller.
Programma-Code
Optie expliciet
Privé m_TheFile As String, m_TheSection As Variant
Privé Username As String, wachtwoord As String, iTemp() As String
Privé pForm als vorm, pTimer als Timer, ptxtBox als TextBox, pInet als Inet
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Public Sub initGmailAccount (TheFile As String, TheSection As Variant, fForm As Variant, fTimer As Variant, ftxtBox As Variant, fInet As Variant)
Op fout GoTo ERRR
m_TheFile = TheFile
m_TheSection = TheSection
Instellen van pForm = fForm: Set pTimer = fTimer: Set ptxtBox = ftxtBox: pInet instellen = fInet
Log "INI:" & m_TheFile & vbCrLf & "sectie:" & m_TheSection
pTimer.Enabled = False ' de timer stoppen!
pTimer.Interval = SimpleGet("interval") * 1000 ' instellen van de timer!
pTimer.Enabled = True ' start de timer!
Log "Interval:" & pTimer.Interval / 1000 & "seconden"
Gebruikersnaam = SimpleGet("username")
Log "gebruikersnaam:" & gebruikersnaam
Wachtwoord = SimpleGet("password")
Log "wachtwoord: ***"
Log "Instellingen geladen..."
Exit Sub
ERRR:
Log "fout in LoadSettings:" & Err.Description
Resume Next
End Sub
Public Function CheckMail (ByVal ToTextFile As String) As Boolean
Op fout GoTo ERRR ' foutafhandeling. een must.
Dim STRTemp As String ' in "strtemp" zetten we de hele webpagina
Dim mailCount As String, mailTitle As String, mailSummary As String
STRTemp = pInet.OpenURL ("https://" & gebruikersnaam & ":" & wachtwoord & "
STRTemp = UCase(STRTemp)
mailCount = rechts (STRTemp, Len(STRTemp) - InStr (1, STRTemp, "FULLCOUNT") - 9)
mailCount = Left (mailCount, InStr (1, mailCount, "<") - 1)
mailTitle = rechts (STRTemp, Len(STRTemp) - InStr (1, STRTemp, "titel > L") - 5)
mailTitle = Left (mailTitle, InStr (1, mailTitle, "<") - 1)
Als StrComp (mailTitle = "LIGHTCONTROL", vbTextCompare) = 0 & mailCount = "1" Then
mailSummary = rechts (STRTemp, Len(STRTemp) - InStr (1, STRTemp, 'Samenvatting') - 7)
mailSummary = Left (mailSummary, InStr (1, mailSummary, "<") - 1)
' belasting bericht in de openbare variabele
iTemp() = Strings.Split (mailSummary, ";")
' mail-gegevens in een tekstbestand opslaan
Open ToTextFile voor uitvoer als #1
Dim i As Integer
Voor i = LBound(iTemp()) naar UBound(iTemp())
Print #1, iTemp(i)
Volgende
Nauwe #1
CheckMail = True
Anders
Log "Mail niet beschikbaar!!!"
CheckMail = False
End If
Exit Function
ERRR:
Log "fout in CheckMail:" & Err.Description
Resume Next
End Function
Public Sub Log (tekst als tekenreeks)
Op fout GoTo ERRR
ptxtBox.Text = tekst & vbCrLf & ptxtBox.Text
Exit Sub
ERRR:
MsgBox "fout voordat ze zich aanmelden:" & Err.Description
Resume Next
End Sub
Public Function SimpleGet (VarName As String) As String
Statische sLocalBuffer As String * 500
Dim l As Integer
l = GetPrivateProfileString (m_TheSection, VarName, vbNullString, sLocalBuffer, 500, m_TheFile)
SimpleGet = links$ (sLocalBuffer, l)
End Function
Public Sub SimplePut (TheItem As Variant, TheVal As Variant)
Bel WritePrivateProfileString (m_TheSection, CStr(TheItem), CStr(TheVal), m_TheFile)
' Flush buffer
Bel WritePrivateProfileString (0, 0, 0 &, m_TheFile)
End Sub
