CRÉER UNE DLL STANDARD AVEC VB6

Option Explicit

Public Sub Main()

Dim SpecialLink As Boolean, fCPL As Boolean, fResource As Boolean

Dim intPos As Integer

Dim strCmd As String

Dim strPath As String

Dim strFileContents As String

Dim strDefFile As String, strResFile As String

Dim oFS As New Scripting.FileSystemObject

Dim fld As Folder

Dim fil As File

Dim ts As TextStream, tsDef As TextStream

strCmd = Command

Set ts = oFS.CreateTextFile(App.Path & "\lnklog.txt")

ts.WriteLine "Beginning execution at " & Date & " " & Time()

ts.WriteBlankLines 1

ts.WriteLine "Command line arguments to LINK call:"

ts.WriteBlankLines 1

ts.WriteLine " " & strCmd

ts.WriteBlankLines 2

' Determine if .DEF file exists

'

' Extract path from first .obj argument

intPos = InStr(1, strCmd, ".OBJ", vbTextCompare)

strPath = Mid(strCmd, 2, intPos + 2)

intPos = InStrRev(strPath, "\")

strPath = Left(strPath, intPos - 1)

' Open folder

Set fld = oFS.GetFolder(strPath)

' Get files in folder

For Each fil In fld.Files

If UCase(oFS.GetExtensionName(fil)) = "DEF" Then

strDefFile = fil

SpecialLink = True

End If

If UCase(oFS.GetExtensionName(fil)) = "RES" Then

strResFile = fil

fResource = True

End If

If SpecialLink And fResource Then Exit For

Next

' Change command line arguments if flag set

If SpecialLink Then

' Determine contents of .DEF file

Set tsDef = oFS.OpenTextFile(strDefFile)

strFileContents = tsDef.ReadAll

If InStr(1, strFileContents, "CplApplet", vbTextCompare) > 0 Then

fCPL = True

End If

' Add module definition before /DLL switch

intPos = InStr(1, strCmd, "/DLL", vbTextCompare)

If intPos > 0 Then

strCmd = Left(strCmd, intPos - 1) & _

" /DEF:" & Chr(34) & strDefFile & Chr(34) & " " & _

Mid(strCmd, intPos)

End If

' Include .RES file if one exists

If fResource Then

intPos = InStr(1, strCmd, "/ENTRY", vbTextCompare)

strCmd = Left(strCmd, intPos - 1) & Chr(34) & strResFile & _

Chr(34) & " " & Mid(strCmd, intPos)

End If

' If Control Panel applet, change "DLL" extension to "CPL"

If fCPL Then

strCmd = Replace(strCmd, ".dll", ".cpl", 1, , vbTextCompare)

End If

' Write linker options to output file

ts.WriteLine "Command line arguments after modification:"

ts.WriteBlankLines 1

ts.WriteLine " " & strCmd

ts.WriteBlankLines 2

End If

ts.WriteLine "Calling LINK.EXE linker"

Shell "linklnk.exe " & strCmd

If Err.Number <> 0 Then

ts.WriteLine "Error in calling linker..."

Err.Clear

End If

ts.WriteBlankLines 1

ts.WriteLine "Returned from linker call"

ts.Close

End Sub

Option Explicit

Public Const DLL_PROCESS_DETACH = 0

Public Const DLL_PROCESS_ATTACH = 1

Public Const DLL_THREAD_ATTACH = 2

Public Const DLL_THREAD_DETACH = 3

Public Function DllMain(hInst As Long, fdwReason As Long, lpvReserved As Long) As Boolean

Select Case fdwReason

Case DLL_PROCESS_DETACH

' No per-process cleanup needed

Case DLL_PROCESS_ATTACH

DllMain = True

Case DLL_THREAD_ATTACH

' No per-thread initialization needed

Case DLL_THREAD_DETACH

' No per-thread cleanup needed

End Select

End Function

Public Function Increment(var As Integer) As Integer

If Not IsNumeric(var) Then Err.Raise 5

Increment = var + 1

End Function

Public Function Decrement(var As Integer) As Integer

If Not IsNumeric(var) Then Err.Raise 5

Decrement = var - 1

End Function

Public (var As Long) As Long

If Not IsNumeric(var) Then Err.Raise 5

Square = var ^ 2

End Function

NAME MathLib

LIBRARY MathMod

DESCRIPTION "Add-on Library of Mathematical Routines"

EXPORTS DllMain @1

Increment @2

Decrement @3

Square @4

Option Explicit

Public Declare Function Increment Lib "C C:\Program Files\Microsoft Visual Studio\VB98\mathdll \MathLib.dll" ( value As Integer) As Integer

Public Declare Function Decrement Lib "C C:\Program Files\Microsoft Visual Studio\VB98\mathdll \MathLib.dll " ( value As Integer) As Integer

Public Declare Function Square Lib " C:\Program Files\Microsoft Visual Studio\VB98\mathdll \MathLib.dll " ( value As Long) As Long

Option Explicit

Private Sub cmdDecrement_Click()

txtDecrement.Text = Decrement(CInt(txtDecrement.Text))

End Sub

Private Sub cmdIncrement_Click()

txtIncrement.Text = Increment(CInt(txtIncrement.Text))

End Sub

Private Sub cmdSquare_Click()

txtSquare.Text = Square(CLng(txtSquare.Text))

End Sub

Private Sub Form_Load()

txtIncrement.Text = 0

txtDecrement.Text = 100

txtSquare.Text = 2

End Sub