|
восстановление на основе TTX
|
|||
---|---|---|---|
#18+
Всем привет. Подскажите есть какой нибудь инструмент восстановления файлов TTX на основе отчетов . Дело в том что у меня отчет на cristal reports который использует источник данных файлы TTX. Он большой и там куча subreport-ов. В инете нашел скрипт на vbscript вот код Код: vbnet 1. 2. 3. 4. 5. 6. 7. 8. 9. 10. 11. 12. 13. 14. 15. 16. 17. 18. 19. 20. 21. 22. 23. 24. 25. 26. 27. 28. 29. 30. 31. 32. 33. 34. 35. 36. 37. 38. 39. 40. 41. 42. 43. 44. 45. 46. 47. 48. 49. 50. 51. 52. 53. 54. 55. 56. 57. 58. 59. 60. 61. 62. 63. 64. 65. 66. 67. 68. 69. 70. 71. 72. 73. 74. 75. 76. 77. 78. 79. 80. 81. 82. 83. 84. 85. 86. 87. 88. 89. 90. 91. 92. 93. 94. 95. 96. 97. 98. 99. 100. 101. 102. 103. 104. 105. 106. 107. 108. 109. 110. 111. 112.
но у меня ругается , что не может создать ActiveX CrystalRuntime.Application Dim app ' Application Dim rep ' Report Dim srep ' Subreport Dim subrep ' Subreport Dim fso ' FileSysstemObject Dim line Dim typ 'On Error Resume Next If WScript.Arguments.Count = 0 Then WScript.Echo "Usage : createttx.vbs report.rpt" WScript.Quit End If Set app = CreateObject("CrystalRuntime.Application") Set rep = app.OpenReport(WScript.Arguments(0), 1) Set fso = CreateObject("Scripting.FileSystemObject") For Each obj In rep.Database.Tables if not fso.FolderExists(obj.Name) then fso.CreateFolder(obj.Name) end if WScript.Echo obj.Name Set txt = fso.CreateTextFile(obj.Name & "\" & obj.Location & ".ttx") For Each fld In obj.Fields line = fld.Name line = Mid(line, 2, Len(line) - 2) line = Mid(line, InStr(line, ".") + 1, Len(line) - InStr(line, ".")) typ = GetFieldType(fld) txt.Write (line + Chr(9) + typ + Chr(9) + CStr((fld.NumberOfBytes-2)/2) + Chr(13) + Chr(10)) Next txt.Close obj.Location = fso.GetAbsolutePathName(".") & "\" & obj.Name & "\" & obj.Location & ".ttx" WScript.Echo obj.Location 'rep.Database.Verify Next For Each sect In rep.Sections For Each repobj In sect.ReportObjects 'If Left(repobj.Name, 3) = "Sub" Then - Modified here 21-11-2003 If repobj.Kind = 5 Then Set subrep = repobj Set srep = rep.OpenSubreport(subrep.SubreportName) For Each mobj in srep.Database.Tables if not fso.FolderExists(mobj.Name) then fso.CreateFolder(mobj.Name) end if Set txt = fso.CreateTextFile(mobj.Name & "\" & mobj.Location & ".ttx") 'Modified here - 19-11-2003 (Subreport name is not the same as Recordset name) 'Set txt = fso.CreateTextFile(srep.Name & "_" & mobj.Name + ".ttx") For Each obj In srep.Database.Tables For Each fld In obj.Fields line = fld.Name line = Mid(line, 2, Len(line) - 2) line = Mid(line, InStr(line, ".") + 1, Len(line) - InStr(line, ".")) typ = GetFieldType(fld) txt.Write (CStr(line) & Chr(9) & typ & Chr(9) & CStr((fld.NumberOfBytes-2)/2) & Chr(13) & Chr(10)) Next if mobj.Name <> mobj.Location then mobj.SetDataSource fso.GetAbsolutePathName(".") + "\" + mobj.Name & "\" & mobj.Location & ".ttx" mobj.Location = fso.GetAbsolutePathName(".") + "\" + mobj.Name & "\" & mobj.Location & ".ttx" else mobj.Location = fso.GetAbsolutePathName(".") + "\" + mobj.Name & "\" & mobj.Location & ".ttx" end if WScript.Echo obj.Location 'srep.Database.Verify Next txt.Close Next End If Next Next rep.Database.Verify 'WScript.Sleep 4000 rep.SaveAs WScript.Arguments(0) + ".rpt", 2048 'Set fso = Nothing Set rep = Nothing Set app = Nothing fso.DeleteFile WScript.Arguments(0) fso.MoveFile WScript.Arguments(0) + ".rpt", WScript.Arguments(0) Set fso = Nothing '===================================================================== Function GetFieldType(ByVal curfld) if (curfld.ValueType = 2) then GetFieldType = "Byte" elseif (curfld.ValueType = 3) then GetFieldType = "Short" elseif (curfld.ValueType = 5) then GetFieldType = "Long" elseif (curfld.ValueType = 7) then GetFieldType = "Number" elseif (curfld.ValueType = 8) then GetFieldType = "Currency" elseif (curfld.ValueType = 9) then GetFieldType = "Boolean" elseif (curfld.ValueType = 10) then GetFieldType = "Date" elseif (curfld.ValueType = 12) then GetFieldType = "String" elseif (curfld.ValueType = 14) then GetFieldType = "Memo" elseif (curfld.ValueType = 15) then GetFieldType = "BLOB" else GetFieldType = "UKNOWN Type: " & Trim(Str(curfld.ValueType)) End If End Function у меня не проходит скрипт ругается что не может создать активХ CristalRuntime.Application. Не пойму что ему не хватает. У меня стоит w7 x64 ,vs2010 и CR11 триалка последняя. Может есть какое нибудь решение. ... |
|||
:
Нравится:
Не нравится:
|
|||
05.06.2013, 10:54 |
|
восстановление на основе TTX
|
|||
---|---|---|---|
#18+
Сам себе расскажу. Скрипт рабочий все как всегда не тот cscript.exe запускал так как у меня w7 x64 надо вот так делать %systemroot%\SysWOW64\cscript.exe. Так что если кому надо восстановить источник данных на основе отчета с этим скриптом все получится. Удачи. ... |
|||
:
Нравится:
Не нравится:
|
|||
06.06.2013, 07:17 |
|
|
start [/forum/topic.php?fid=31&msg=38286346&tid=1534032]: |
0ms |
get settings: |
7ms |
get forum list: |
12ms |
check forum access: |
4ms |
check topic access: |
4ms |
track hit: |
66ms |
get topic data: |
8ms |
get forum data: |
2ms |
get page messages: |
40ms |
get tp. blocked users: |
2ms |
others: | 272ms |
total: | 417ms |
0 / 0 |