Programmierseite - Interessante Themen
 Hauptseite |  Bücherseite |  Linkseite |  Linuxseite |  Programmierseite |  Ereignisse

<< Zurück Alle Angaben ohne Gewähr. Benutzung auf eigenes Risiko.
(C) Copyright Bernd Noetscher 1995 - 2000 eMail: webmaster@berndnoetscher.de

Access 97
mit Visual Basic



This software may be used and distributed according to the terms of the GNU Public License, incorporated herein by reference.

BuildAndRunSubAtRuntime & Tokenizer.mdb

Mod_BuildAndRunSub
Mod_Run
Mod_Tokenizer
Mod_Use_BuildAndRunSub
Mod_Use_Tokenizer
Mod_BuildAndRunSub

Attribute VB_Name = "Mod_BuildAndRunSub"
' author: Bernd Noetscher - 04.1999
' free source code - use at your own risk

Option Compare Database
Option Explicit

Public Function BuildRunSub(sModName As String, sFunction As String, sText As String, Optional bRunFunction As Variant)
Dim Mdl As Module
Dim lStartLine As Long
Dim lCount As Long
Dim sFunctionName As String

On Error GoTo Err_

Application.Echo False
sFunctionName = sFunction

Application.DoCmd.OpenModule sModName
Set Mdl = Application.Modules(sModName)

If Mdl.Find(sFunctionName, 0, 0, 0, 0) Then
lCount = Mdl.ProcCountLines(sFunctionName, vbext_pk_Proc)
lStartLine = Mdl.ProcStartLine(sFunctionName, vbext_pk_Proc)
If lCount > 0 And lStartLine > 0 Then
Mdl.DeleteLines lStartLine, lCount
End If
End If

Mdl.AddFromString (sText)

Set Mdl = Nothing
Application.DoCmd.Close acModule, sModName, acSaveYes
Application.Echo True

If Not IsMissing(bRunFunction) Then
If bRunFunction = True Then
runFunction (sFunctionName)
End If
End If

BuildRunSub = True
Ex_:
Exit Function
Err_:
Application.Echo True
MsgBox Err.Description
Resume Ex_
End Function

Private Sub runFunction(sFunctionName As String)
Run sFunctionName
End Sub
Mod_Run

Attribute VB_Name = "Mod_Run"
' author: Bernd Noetscher - 04.1999
' free source code - use at your own risk

Option Compare Database
Option Explicit

Public Sub HelloWorld()
MsgBox "Hello World !"
End Sub
Mod_Tokenizer

Attribute VB_Name = "Mod_Tokenizer"
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' author: Bernd Noetscher - 04.1999
' free source code - use at your own risk

Option Compare Database
Option Explicit

Public lCurrentPos As Long

Public Function getNextToken(sText As String, sDelemitor As String)
Dim sStri As String
Dim sStri2 As String
Dim vVal As Variant
Dim i As Integer
Dim nVal As Integer

On Error GoTo Err_

sStri2 = vbNullString
i = lCurrentPos
If i <= Len(sText) Then
vVal = InStr(i, sText, sDelemitor)
If vVal > 0 Then
sStri = Mid(sText, i, vVal - i)
nVal = Len(sDelemitor)
Else
sStri = Mid(sText, i, Len(sText) - i + 1)
nVal = 0
End If
i = i + Len(sStri) + nVal
sStri2 = sStri2 + sStri
End If
lCurrentPos = i
getNextToken = sStri2
Ex_:
Exit Function
Err_:
MsgBox Err.Description
Resume Ex_
End Function

Private Sub Class_Initialize()
lCurrentPos = 1
End Sub
Mod_Use_BuildAndRunSub

Attribute VB_Name = "Mod_Use_BuildAndRunSub"
' author: Bernd Noetscher - 04.1999
' free source code - use at your own risk

Option Compare Database
Option Explicit

Public Function Use_BuildRunSub()
Dim sFunctionName As String
Dim sFunctionBody As String

sFunctionName = vbNullString
sFunctionBody = vbCrLf

sFunctionName = "HelloWorld"

sFunctionBody = sFunctionBody & "Public Sub " & sFunctionName & "()" & vbCrLf
sFunctionBody = sFunctionBody & " MsgBox ""Hello World !""" & vbCrLf
sFunctionBody = sFunctionBody & "End Sub "

BuildRunSub "Mod_Run", sFunctionName, sFunctionBody, bRunFunction:=True
End Function
Mod_Use_Tokensizer

Attribute VB_Name = "Mod_Use_Tokenizer"
' author: Bernd Noetscher - 04.1999
' free source code - use at your own risk

Option Compare Database
Option Explicit

Public Function Use_()
Dim Token As New Mod_Tokenizer
Dim sStri As String

Do
sStri = Token.getNextToken("this;is;a;tokenizer;test", ";")
Loop While sStri <> vbNullString
End Function
<< Zurück Alle Angaben ohne Gewähr. Benutzung auf eigenes Risiko.
(C) Copyright Bernd Noetscher 1995 - 2000 eMail: webmaster@berndnoetscher.de