Форум

цитата:

'
'extern "C" void WINAPI AboutDLL() - О программе
'extern "C" void WINAPI LoadWord(char *fname) - Загрузка WinWord (параметр имя файла)
'extern "C" int WINAPI RunRepDial(CString &fname,int isd) - Отладка отчета (параметр шаблон, isd)
'extern "C" int WINAPI RunReport(CString &fname,int isd) - Выполнить отчет (параметр шаблон, isd)
'extern "C" int WINAPI RunRep(char * fname,int isd) - Отладка отчета (параметр шаблон, isd)
'extern "C" int WINAPI RunDial(char * fname,int isd) - Отладка отчета (параметр шаблон, isd)
'
'fname - имя файла шаблона
'isd - Маска:
' 0 - работа в текущей папке,
' 1 - в папке шаблона,
' 16 - не выдавать файл отчета на экран
'
'
'Public Declare Function RunDial Lib "genrep.dll" (ByVal SabName As String, ByVal nFlag As Integer) As Integer
'Public Declare Function RunRep Lib "genrep.dll" (ByVal SabName As String, ByVal nFlag As Integer) As Integer
'Public Declare Sub AboutDLL Lib "genrep.dll" ()
'
'Ret = Runr('namefile.sab' , 0+1)
'ret = Rund('namefile.sab' , 0)
'ret = Runr('namefile.sab' , 0+16) && не вызывать Word

Public Declare Function RunDial Lib "genrep.dll" (ByVal SabName As String, ByVal nFlag As Integer) As Integer
Public Declare Function RunRep Lib "genrep.dll" (ByVal SabName As String, ByVal nFlag As Integer) As Integer
Public Declare Sub AboutDLL Lib "genrep.dll" ()

Declare Function OemToCharBuff Lib "user32" Alias "OemToCharBuffA" (ByVal lpszSrc As String, ByVal lpszDst As String, ByVal cchDstLength As Long) As Long

Public Sub Genrep_About()
AboutDLL
End Sub

Public Sub Genrep_RunDialog(sab As String)

ret = RunDial(sab, 1)

End Sub

Public Sub Genrep_RunReport(NameSab As String, ByVal nFlag As Integer)

ret = RunRep(NameSab, nFlag)

End Sub

Public Function ToAnsi(ByVal S As String) As String
Dim Buffer As String * 1000
OemToCharBuff S, Buffer, Len(S)
ToAnsi = Trim(Buffer)
End Function

Public Sub CreateDbfFromRecordset_VFP(r As ADODB.Recordset, ByVal DbfName As String, DbfFolder As String)
Dim cn As New ADODB.Connection, f As ADODB.Field, S As String, sDbfFile As String
Dim rr As New ADODB.Recordset, i As Integer, ii As Integer

sCon = "driver=Microsoft dBase Driver (*.dbf);Exclusive=Yes;SourceType=DBF;Collate=machine;SourceDB=" & DbfFolder
cn.Open sCon

sDbfFile = DbfFolder & DbfName & ".dbf"
On Error Resume Next
GetAttr sDbfFile
If Err.Number = 0 Then Kill sDbfFile
On Error GoTo 0

For Each f In r.Fields
If Len(S) Then S = S & ","
Select Case f.Type
Case adUnsignedTinyInt, adSmallInt, adInteger, adSingle, adDouble, adCurrency, adBoolean
S = S & "" & f.Name & " Integer"
Case adDate
S = S & "" & f.Name & " Date"
Case adVarChar, adVarWChar, adChar, adWChar
S = S & "" & f.Name & " Char(" & f.DefinedSize & ")"
End Select
Next f

sCmd = "CREATE TABLE " & DbfName & " (" & S & ")"
cn.Execute sCmd

rr.Open "SELECT * FROM " & DbfName, cn, adOpenStatic, adLockOptimistic
ii = r.Fields.Count - 1
Do Until r.EOF
rr.AddNew
For i = 0 To ii
rr(i) = r(i)
Next i
rr.Update
r.MoveNext
Loop
End Sub

Public Sub CreateDbfFromRecordset(r As ADODB.Recordset, ByVal DbfName As String, DbfFolder As String)
Dim cn As New ADODB.Connection, f As ADODB.Field, S As String, sDbfFile As String
Dim rr As New ADODB.Recordset, i As Integer, ii As Integer

cn.Open "Provider=MSDASQL.1;Data Source=dBASE Files;Initial Catalog=" & DbfFolder

sDbfFile = DbfFolder & DbfName & ".dbf"
On Error Resume Next
GetAttr sDbfFile
If Err.Number = 0 Then Kill sDbfFile
On Error GoTo 0

For Each f In r.Fields
If Len(S) Then S = S & ","
Select Case f.Type
Case adUnsignedTinyInt, adSmallInt, adInteger, adSingle, adDouble, adCurrency, adBoolean
S = S & "[" & f.Name & "] INT"
Case adDate
S = S & "[" & f.Name & "] DATE"
Case adVarChar, adVarWChar, adChar, adWChar
S = S & "[" & f.Name & "] TEXT(" & f.DefinedSize & ")"
End Select
Next f

cn.Execute "CREATE TABLE " & DbfName & "(" & S & ")"

rr.Open "SELECT * FROM " & DbfName, cn, adOpenStatic, adLockOptimistic
ii = r.Fields.Count - 1
Do Until r.EOF
rr.AddNew
For i = 0 To ii
If r(i).Type Then rr(i) = ToAnsi(r(i)) Else rr(i) = r(i)
Next i
rr.Update
r.MoveNext
Loop
End Sub

Dim con As New ADODB.Connection, cst As String, rst_a As New ADODB.Recordset

Private Sub cmdDial_Click()
Genrep_RunDialog ("sab\formats.sab")
End Sub

' Справочник
Private Sub cmdRun_Click()

cst = "Provider=SQLOLEDB.1;User Id=username;Password=123;Initial Catalog=rb;Data Source=serv-1"
con.Open cst
Set rst_a = con.Execute("select top 10 Code, Descr from SC6482")

' скидываем в DBF
CreateDbfFromRecordset_VFP rst_a, "temp", "" ' "C:\1CDATA\programm\genrep\"

rst_a.Close
Set rst_a = Nothing
con.Close

' Выводим в RTF
Genrep_RunReport "sab\sprav.sab", 0

End Sub