Newsgroup: it.comp.lang.visual-basic
Titolo: Funzioni C per Visual Basic

       *
'* Improved by Serge Baranovsky                             *
'*----------------------------------------------------------*
Public Sub sPrintF(ByRef buffer As String, _
                   ByVal formats As String, _
                   ParamArray arguments() As Variant)
  Dim DefLen As Integer, DefIdx As Integer
  Dim CurIdx As Integer, WorkString As String
  Dim CurVal As Integer, MaxVal As Integer
  Dim CurFormat As String, ValCount As Integer
  Dim xIndex As Integer, FoundV As Boolean, vType As paramType
  Dim CurParm As String
  DefLen = Len(formats)
  DefIdx = 1
  CurVal = 0
  MaxVal = UBound(arguments) + 1
  ValCount = 0
  ' Check for equal number of 'flags' as values,
  ' raise an error if inequal
  Do
    CurIdx = InStr(DefIdx, formats, "%")
    If CurIdx > 0 Then
      ' don't count %%, will be converted to % later
      If Mid$(formats, CurIdx + 1, 1) <> "%" Then
        ValCount = ValCount + 1
        DefIdx = CurIdx + 1
      Else
        DefIdx = CurIdx + 2
      End If
    Else
      Exit Do
    End If
  Loop
  If ValCount <> MaxVal Then
    Err.Raise 450, , "Mismatch of parameters for string '" & _
                     formats & "'. Expected " & ValCount & _
                     ", but received " & MaxVal & "."
  End If
  DefIdx = 1
  CurVal = 0
  ValCount = 0
  WorkString = ""
  formats = ReplaceControls(formats)
  Do
    CurIdx = InStr(DefIdx, formats, "%")
    If CurIdx <> 0 Then
      ' First, get the variable identifier. Scan from Defidx (the %)
      ' to EOL looking for the first occurance of s, d, l, or f
      FoundV = False
      vType = prmNone
      xIndex = CurIdx + 1
      Do While FoundV = False
        If Not FoundV Then
          CurParm = Mid$(formats, xIndex, 1)
          Select Case Mid$(formats, xIndex, 1)
            Case "%"
              vType = prmCharPercent
              FoundV = True
              CurIdx = CurIdx + 1
              CurVal = xIndex + 2
            Case "s"
              vType = prmString
              FoundV = True
              CurVal = xIndex + 1
            Case "d"
              vType = prmInteger
              FoundV = True
              CurVal = xIndex + 1
            Case "l"
              If Mid$(formats, xIndex + 1, 1) = "d" Then
                vType = prmLong
                FoundV = True
                CurVal = xIndex + 2
              Else
                Err.Raise 93, , "Unrecognized pattern '" & _
                                Mid$(formats, xIndex - 1, 3) & _
                                "' in '" & formats & "'"
              End If
            Case "f"
              vType = prmFloat
              FoundV = True
              CurVal = xIndex + 1
          End Select
        End If
        If Not FoundV Then xIndex = xIndex + 1
      Loop
      If Not FoundV Then Err.Raise 93, , _
                         "Invalid % format in '" & formats & "'"
      ' Next for debugging purposes
      CurParm = Mid$(formats, CurIdx, CurVal - CurIdx)
      If vType = prmCharPercent Then
        WorkString = WorkString _
                     & Mid$(formats, DefIdx, CurIdx - DefIdx)
        CurVal = CurVal - 1
      Else
        CurFormat = BuildFormat(CurParm, vType)
        WorkString = WorkString _
                     & Mid$(formats, DefIdx, CurIdx - DefIdx) _
                     & format$(arguments(ValCount), CurFormat)
        ValCount = ValCount + 1
      End If
      DefIdx = CurVal
    Else
      WorkString = WorkString _
                   & Right$(formats, Len(formats) - DefIdx + 1)
      Exit Do
    End If
  Loop
  buffer = WorkString
End Sub
Private Function BuildFormat(ByVal Parm As String, _
                             ByVal DataType As paramType) As String
  Dim Prefix As String, TmpFmt As String
  If DataType = prmLong Then
    Prefix = Mid$(Parm, 2, Len(Parm) - 3)
  Else
    Prefix = Mid$(Parm, 2, Len(Parm) - 2)
  End If
  Select Case InStr(Prefix, ".")
    Case 0, Len(Prefix)
      If Left$(Prefix, 1) = "0" Then
        TmpFmt = String(CInt(Prefix), "0")
      Else
        TmpFmt = "#"
      End If
    Case 1
      If Mid$(Prefix, 2, 1) = "0" Then
        TmpFmt = "#." & String(CInt(Right$(Prefix, 2)), "0")
      Else
        TmpFmt = "#.#"
      End If
    Case Else
      If Left$(Prefix, 1) = "0" Then
        TmpFmt = String(CInt(Left$(Prefix, _
                        InStr(Prefix, ".") - 1)), "0") & "."
      Else
        TmpFmt = "#."
      End If
      If Mid$(Prefix, InStr(Prefix, ".") + 1, 1) = "0" Then
        TmpFmt = TmpFmt & String(CInt(Right$(Prefix, _
                                 InStr(Prefix, ".") - 1)), "0")
      Else
        TmpFmt = TmpFmt & "#"
      End If
  End Select
  BuildFormat = TmpFmt
End Function
Private Function ReplaceControls(ByVal srcStr As String) As String
  Dim resStr As String
  Dim CurIdx As Long, DefIdx As Long
  resStr = srcStr
  DefIdx = 1
  Do
    CurIdx = InStr(DefIdx, resStr, "\")
    If CurIdx > 0 Then
      Select Case UCase(Mid$(resStr, CurIdx + 1, 1))
        Case "\"
          resStr = Left$(resStr, CurIdx - 1) & "\" _
                   & Right$(resStr, Len(resStr) - CurIdx - 1)
          CurIdx = CurIdx + 1
        Case "N"
          resStr = Left$(resStr, CurIdx - 1) & vbCr _
                   & Right$(resStr, Len(resStr) - CurIdx - 1)
        Case "R"
          resStr = Left$(resStr, CurIdx - 1) & vbLf _
                   & Right$(resStr, Len(resStr) - CurIdx - 1)
        Case "T"
          resStr = Left$(resStr, CurIdx - 1) & vbTab _
                   & Right$(resStr, Len(resStr) - CurIdx - 1)
        Case Else
          Err.Raise 93, , _
          "Incorrect usage of '\' in '" & srcStr & "'"
      End Select
      DefIdx = CurIdx
    Else
      Exit Do
    End If
  Loop
  ReplaceControls = resStr
End Function


[...Snip...]
Non vorrei sembrarti scortese, ma non capisco bene quale sia lo scopo. In
basic c'č la funzione Format$ che fa molto di piů di quello che fa sprintf
:)

Non vorrei svilire il tuo lavoro, ma mi sembra abbastanza pratico scrivere
una dll 'standard' (non COM) che contenga funzioni che sviluppano
l'equivalente C - qualcosa come:
void APIENTRY SplitPath(LPSTR path, LPSTR drive, LPSTR dir, LPSTR fname,
LPSTR ext)
{
 _splitpath(path,drive,dir,fname,ext);
}
Magari farlo in VB è un ottimo esercizio, ma raccomando comunque di usare
quello che c'è già, visto che l'implementazione è veramente elementare
(ovviamente richiede un compilatore C in grado di creare DLL).
----------------------------------------------------------------------
Stefano Minardi
Zetesis: 
zet...@mclink.it
----------------------------------------------------------------------

 :)
stai scherzando vero?