利用SQL指令找出資料庫的資料表,資料表的欄位名,資料表的PK欄位

參考引用
--
找出資料庫裡所有的資料表

SELECT TABLE_NAME FROM INFORMATION_SCHEMA.TABLES ORDER BY TABLE_NAME

依資料表名稱找出所有欄位資訊

SELECT COLUMN_NAME,ORDINAL_POSITION,DATA_TYPE,CHARACTER_MAXIMUM_LENGTH FROM INFORMATION_SCHEMA.COLUMNS WHERE TABLE_NAME = 'Table1'

依資料表名稱找出此表的PK欄位

SELECT COLUMN_NAME FROM INFORMATION_SCHEMA.KEY_COLUMN_USAGE WHERE TABLE_NAME = 'Table1'

電子憑證相關問題

憑證問題
--
一般會問到的問題,這兒差不多都有了喔
多看看不錯喔,當遇到問題就能排除或找方法

vbnet web 點擊 click

範例1:
HtmlElements elements = this.webBrowserControl.GetElementsByTagName("Input");

foreach(HtmlElement currentElement in elements)
{
currentElement.InvokeMember("click");
}

Dim elements As HtmlElements = Me.webBrowserControl.GetElementsByTagName("Input")
For Each currentElement As HtmlElement In elements
    currentElement.InvokeMember("click")
Next



範例2:
Me.WebBrowser1.Navigate(New Uri("http://www.yahoo.com"))

Me.ListBox1.Items.Add("Type" & "-->" & "Name")
For Each element As HtmlElement In Me.WebBrowser1.document.All
Me.ListBox1.Items.Add(element.TagName() & "-->" & element.Id)
Next


範例3:***本組ok***
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Me.WebBrowser1.Navigate(New Uri("http://www.yahoo.com"))
        Dim theElementCollection As HtmlElementCollection = WebBrowser1.Document.GetElementsByTagName("button")
        For Each curElement As HtmlElement In theElementCollection
            Dim controlName As String = curElement.GetAttribute("name").ToString
            controlName = "login"
                curElement.InvokeMember("click")
        Next
    End Sub


 範例4:good 引用 
Private Sub LogInSub()
        On Error GoTo err1
        WebBrowser1.Navigate(" webaddress")
        While WebBrowser1.ReadyState <> WebBrowserReadyState.Complete
            Application.DoEvents()
        End While
        Dim theElementCollection As HtmlElementCollection
        theElementCollection = WebBrowser1.Document.GetElementsByTagName("Input")
        For Each curElement As HtmlElement In theElementCollection
            Dim controlName As String = curElement.GetAttribute("id").ToString
            If controlName = "email" Then
                curElement.SetAttribute("Value", "username for site")
            End If
        Next
        theElementCollection = WebBrowser1.Document.GetElementsByTagName("Input")
        For Each curElement As HtmlElement In theElementCollection
            Dim controlName As String = curElement.GetAttribute("id").ToString
            If controlName = "password" Then
                curElement.SetAttribute("Value", "password for site")
            End If
        Next
        WebBrowser1.Document.Forms("login_pw").InvokeMember("submit")
err1:
        Exit Sub
    End Sub

VB6 控制 IE 填入值及點擊按鈕

參考引用
--
 ' 需引用 iframe.dll 元件
' 需引用 MSHTML.TLB 元件

Dim WithEvents IE As InternetExplorer
Dim Doc As HTMLDocument

Private Sub Command1_Click()
    IENavigate "http://xxxxx"
End Sub

Private Sub Command2_Click()
    IENavigate "http://www."
End Sub

Private Sub Command3_Click()
    ObjSetValue "input", "ctl00$TzuhuHolder$usridTxt", tb_usridTxt.Text
    ObjSetValue "input", "ctl00$TzuhuHolder$nameTxt", tb_nameTxt.Text
    ObjSetValue "select", "ctl00$TzuhuHolder$yearDDL", cb_yearDDL.Text
    ObjSetValue "select", "ctl00$TzuhuHolder$monthDDL", cb_monthDDL.Text
End Sub

' 建立IE及開啟某網頁
Sub IENavigate(URL As String)
    If IE Is Nothing Then Set IE = New InternetExplorer
    IE.Visible = True
    IE.Width = 1024 + 15
    IE.Height = 640
    IE.navigate URL
End Sub

' 在 IE 載入完成時，要做的事情
Private Sub IE_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    Dim BObj As Object
    Set BObj = Nothing
    Set Doc = IE.document
    If UrlCheck(URL, "reminder.aspx") Then
    Call ButtonCheck("ctl00$TzuhuHolder$mybutton")
   
    ElseIf UrlCheck(URL, "declare.aspx") Then
   
    ElseIf UrlCheck(URL, "process.aspx") Then
   
    ElseIf UrlCheck(URL, "index.aspx") Then
 Call ButtonCheck("ImageButton1")

    End If
End Sub

' 控制改變某物件的值
Sub ObjSetValue(ObjTagName As String, ObjID As String, ObjValue As String)
    Dim I As Long, BObj As Object
    Dim DocIB As Object
    Set BObj = Nothing
    ObjTagName = LCase(ObjTagName)
    Set DocIB = Doc.getElementsByTagName(ObjTagName)
    For I = 0 To DocIB.length - 1
    If LCase(DocIB(I).id) = LCase(ObjID) Or LCase(DocIB(I).Name) = LCase(ObjID) Then
    Set BObj = Doc.getElementById(ObjID)
    Exit For
    End If
    Next
    If Not BObj Is Nothing Then
    Select Case ObjTagName
    Case "input", "select"
    BObj.Value = ObjValue
    End Select
    End If
End Sub

' 控制點擊某按鈕 (Button) ( Click )
Function ButtonCheck(ObjID As String) As Boolean
    ButtonCheck = False
    If Doc Is Nothing Then Exit Function

    Dim I As Long, BObj As Object
    Dim DocIB As Object
    Set BObj = Nothing
    Set DocIB = Doc.getElementsByTagName("input")
    For I = 0 To DocIB.length - 1
    If LCase(DocIB(I).id) = LCase(ObjID) Or LCase(DocIB(I).Name) = LCase(ObjID) Then
    Set BObj = Doc.getElementById(ObjID)
    Exit For
    End If
    Next

    If Not BObj Is Nothing Then
    BObj.disabled = False
    BObj.Click
    End If

End Function

Function UrlCheck(URL As Variant, ObjID As String) As Boolean
    UrlCheck = LCase(Right(URL, Len(ObjID))) = LCase(ObjID)
End Function

WCF教學

米米貓學開發: WCF教學
--
此範例是用 C# 的喔
寫得還不錯,初學者必看喔

另外,VBNET 的可參考此處(很多細節都有說喔!)
mis2000lab WCF 新手入門 #1 (有很多篇,要慢慢學)
 

Ethereal 抓網路封包+封包內容分析+看明碼連線內容

請參考來源
---
ethereal 官網下載
 

如何快速刪除無名網誌文章

雖然無名只能一篇一篇刪除，

不過有一個方法，

可以花少需的時間就將大量的文章刪除，

先點「所有文章列表」

或是直接輸入http://www.wretch.cc/blog/你的帳號&list=1

每篇文章都有「刪除」的連結，

在你想要刪除的文章上按右鍵，

選新開網頁，快捷鍵為N。
開新的頁面後，文章就已經刪除了。

租書軟體如何運用營業在餐飲類

租書軟體如何運用營業在餐飲類
很多漫畫店想營業複合式經營,卻往往被已使用的租書軟體限制住
目前能多方向經營的租書軟體:Estory 漫畫視界 , 可以針對餐飲營業共用
或您是單純的餐飲業,也能使用:Estory 漫畫視界 , 來當收銀系統
一般餐飲,均會提供內閱書籍或雜誌;Estory 漫畫視界 就能多功運用計帳了!
例:
[類別辭庫]
飲料類
A0001 大人最低消費  200  /飲料類
A0002 小孩最低消費  100  /飲料類
B0001 美式咖啡   100   /飲料類
B0002 原味拿鐵   120  /飲料類
B0003 香草拿鐵   130  /飲料類

相關設定,請參考:池龍工作室網站
http://wushi.myftp.org

底下為設定與操作範例:

ActionScript 程式設計

ActionScript 程式設計

手動建立 autorun.inf 目錄

一：建立非法文件夾
1. 開始> 運行>輸入CMD>進入DOS (因為此非法文件夾只能在DOS下建立)。
2. 輸入 X: (其中X代表硬碟分區代號)，按ENTER鍵，如你有C、D、E…等硬碟分區；或是抽取式硬碟(記憶卡、碟)，插入電腦裝置後之分區代號。
3. 輸入「md_autorun.inf」，(注意 _ 表示空格) 建立 autorun.inf 資料夾；按ENTER鍵
4. 輸入「cd_autorun.inf」，(注意 _ 表示空格) 進入 autorun.inf 資料夾；按ENTER鍵
5. 輸入「md_123..」，(注意 _ 表示空格) 123可隨意其他名字，但不要過長，(注意 .. 一定要輸入)，再按ENTER鍵
注意這是關鍵的一步，123的後面一定要輸入兩個點和一個反斜槓，這樣建立的就是一個含有非法字符的文件夾，windows下無法進入也無法刪除了。
6. 回到窗口界面，試試刪除這個文件夾……

二：刪除方法如下：

假設 autorun.inf 資料夾是在D槽，
操作如下： 打開「開始」，選擇「運行」，輸入「CMD」，打開命令行窗口，在命令行窗口中輸入一下命令：
第一步：輸入 X: (其中X代表硬碟分區代號)，再按ENTER鍵
第二步：輸入rmdir_/s_autorun.inf  (注意 _ 表示空格) 然後按ENTER鍵
第三步：當出現提示時，按「Y」，按ENTER鍵

三：其它

不管 autorun.inf 設置了什麼屬性，病毒都會更改它，但依上述的方式創建的，應該就不會被更改了。

四：影響
創建autorun.inf  資料匣會照成Windows 2003 Server 這類Windows系統在賦予使用者資料匣檔案權限時無法套用

vbnet 產生 Excel 檔案

NPOI Library
Open XML SDK 2.0 for Microsoft Office
--
[VB.NET]於5種資料庫存取關鍵程式碼
  

vbnet DataGridView 自動停在最後一筆

vbnet DataGridView 自動停在最後一筆

DGridV.Rows(DGridV.RowCount - 1).Cells(0).Selected = True

asp 防止留言機器人的方法

請參考來源:3樓

Crystal Report Access with VB6

參考引用
--
引用1:
Dim Report As CRAXDRT.Report
Dim SubReport As CRAXDRT.Report
Dim App As CRAXDRT.Application
Dim Sections As CRAXDRT.Sections
Dim Section As CRAXDRT.Section
Dim RepObjs As CRAXDRT.ReportObjects
Dim SubReportObj As CRAXDRT.SubreportObject
Dim n As Integer
Dim i As Integer
Dim j As Integer

  Set App = New CRAXDRT.Application
  Set Report = App.OpenReport("your.rpt")

  For n = 1 To Report.Database.Tables.Count
    Report.Database.Tables(n).SetLogOnInfo "server", "dbname", "user", "pass"
  Next n

  Set Sections = Report.Sections
  For n = 1 To Sections.Count
    Set Section = Sections.Item(n)
    Set RepObjs = Section.ReportObjects
    For i = 1 To RepObjs.Count
      If RepObjs.Item(i).Kind = crSubreportObject Then
         Set SubReportObj = RepObjs.Item(i)
         Set SubReport = SubReportObj.OpenSubreport
         For j = 1 To SubReport.Database.Tables.Count
            SubReport.Database.Tables(j).SetLogOnInfo "server", "db", "username", "pass"
         Next j
      End If
    Next i
  Next n


引用2:
Report = "\\MYPATH\Monthly_Sales_report_new.rpt"
   
    Set rep = appl.OpenReport(Report)
   
   
   
   
'    rep.DiscardSavedData
   
   


rep.ParameterFields.GetItemByName("@First_month_Start_date").AddCurrentValue CDate(txtFirstMonthStart.Text)
rep.ParameterFields.GetItemByName("@First_month_End_date").AddCurrentValue CDate(txtFirstMonthEnd.Text)
rep.ParameterFields.GetItemByName("@Second_month_Start_date").AddCurrentValue CDate(txtSecondMonthStart.Text)
rep.ParameterFields.GetItemByName("@Second_month_End_date").AddCurrentValue CDate(txtSecondMonthEnd.Text)
rep.ParameterFields.GetItemByName("@Year_Start_date").AddCurrentValue CDate(txtYearStart.Text)
rep.ParameterFields.GetItemByName("@Year_End_date").AddCurrentValue CDate(txtYearEnd.Text)
rep.ParameterFields.GetItemByName("@month_second_caption").AddCurrentValue CStr(txtSecondMonthCaption.Text)
rep.ParameterFields.GetItemByName("@month_first_caption").AddCurrentValue CStr(txtFirstMonthCaption.Text)
rep.ParameterFields.GetItemByName("@total_prev_caption").AddCurrentValue txtPrevTotalCaption.Text
rep.ParameterFields.GetItemByName("@Total_current_caption").AddCurrentValue txtCurrentTotalCaption.Text
rep.EnableParameterPrompting = False







Dim eachtable As CRAXDRT.DatabaseTable
For Each eachtable In rep.Database.Tables
    eachtable.ConnectionProperties("user id") = "user"
    eachtable.ConnectionProperties("password") = "Pass"

Next
   
   

Dim Sections As CRAXDRT.Sections
Dim Section As CRAXDRT.Section
Dim RepObjs As CRAXDRT.ReportObjects
Dim SubReportObj As CRAXDRT.SubreportObject
Dim SubReport As CRAXDRT.Report
Dim n As Integer
Dim i As Integer
Dim j As Integer

 Set Sections = rep.Sections
  For n = 1 To Sections.Count
    Set Section = Sections.Item(n)
    Set RepObjs = Section.ReportObjects
    For i = 1 To RepObjs.Count
      If RepObjs.Item(i).Kind = crSubreportObject Then
       
       
         Set SubReportObj = RepObjs.Item(i)
         Set SubReport = SubReportObj.OpenSubreport
         If UCase(Trim(RepObjs.Item(i).Name)) = UCase(Trim("Subreport1")) Then
       
         
            'Set rep = appl.OpenReport(Report)
   
   
   
   SubReport.DiscardSavedData
   
   


SubReport.ParameterFields.GetItemByName("@First_month_Start_date").AddCurrentValue CDate(frmAuto_Email.txtFirstMonthStart.Text)
SubReport.ParameterFields.GetItemByName("@First_month_End_date").AddCurrentValue CDate(frmAuto_Email.txtFirstMonthEnd.Text)
SubReport.ParameterFields.GetItemByName("@Second_month_Start_date").AddCurrentValue CDate(frmAuto_Email.txtSecondMonthStart.Text)
SubReport.ParameterFields.GetItemByName("@Second_month_End_date").AddCurrentValue CDate(frmAuto_Email.txtSecondMonthEnd.Text)
SubReport.ParameterFields.GetItemByName("@Year_Start_date").AddCurrentValue CDate(frmAuto_Email.txtYearStart.Text)
SubReport.ParameterFields.GetItemByName("@Year_End_date").AddCurrentValue CDate(frmAuto_Email.txtYearEnd.Text)
SubReport.ParameterFields.GetItemByName("@month_second_caption").AddCurrentValue CStr(frmAuto_Email.txtSecondMonthCaption.Text)
SubReport.ParameterFields.GetItemByName("@month_first_caption").AddCurrentValue CStr(frmAuto_Email.txtFirstMonthCaption.Text)
SubReport.ParameterFields.GetItemByName("@total_prev_caption").AddCurrentValue frmAuto_Email.txtPrevTotalCaption.Text
SubReport.ParameterFields.GetItemByName("@Total_current_caption").AddCurrentValue frmAuto_Email.txtCurrentTotalCaption.Text


SubReport.EnableParameterPrompting = False


       
       
         End If
       
         If UCase(Trim(RepObjs.Item(i).Name)) = UCase(Trim("Subreport2")) Then
       
         
            'Set rep = appl.OpenReport(Report)
   
   
   
   SubReport.DiscardSavedData
   
   


SubReport.ParameterFields.GetItemByName("@First_month_Start_date").AddCurrentValue CDate(frmAuto_Email.txtFirstMonthStart.Text)
SubReport.ParameterFields.GetItemByName("@First_month_End_date").AddCurrentValue CDate(frmAuto_Email.txtFirstMonthEnd.Text)
SubReport.ParameterFields.GetItemByName("@Second_month_Start_date").AddCurrentValue CDate(frmAuto_Email.txtSecondMonthStart.Text)
SubReport.ParameterFields.GetItemByName("@Second_month_End_date").AddCurrentValue CDate(frmAuto_Email.txtSecondMonthEnd.Text)
SubReport.ParameterFields.GetItemByName("@Year_Start_date").AddCurrentValue CDate(frmAuto_Email.txtYearStart.Text)
SubReport.ParameterFields.GetItemByName("@Year_End_date").AddCurrentValue CDate(frmAuto_Email.txtYearEnd.Text)
SubReport.ParameterFields.GetItemByName("@month_second_caption").AddCurrentValue CStr(frmAuto_Email.txtSecondMonthCaption.Text)
SubReport.ParameterFields.GetItemByName("@month_first_caption").AddCurrentValue CStr(frmAuto_Email.txtFirstMonthCaption.Text)
SubReport.ParameterFields.GetItemByName("@total_prev_caption").AddCurrentValue frmAuto_Email.txtPrevTotalCaption.Text
SubReport.ParameterFields.GetItemByName("@Total_current_caption").AddCurrentValue frmAuto_Email.txtCurrentTotalCaption.Text


SubReport.EnableParameterPrompting = False


       
       
         End If
       
       
       
         For j = 1 To SubReport.Database.Tables.Count
            SubReport.Database.Tables(j).SetLogOnInfo "server", "DB", "User", "Password"
         Next j
       
      End If
    Next i
  Next n

Crystal Reports Dynamic Image

參考引用:Crystal Reports Dynamic Image
--
Option Explicit

Dim Report As CRAXDRT.Report
Dim CRapp As New CRAXDRT.Application
Private WithEvents oSection As CRAXDRT.Section
Dim pic1 As OLEObject
Dim i As Integer


Private Sub Form_Load()

'set the report
Set Report = CRapp.OpenReport(App.Path + "\report1.rpt")
'set the section object to the Details section of the report.
Set oSection = Report.Sections("D")

'Loop through the report objects and see if they are pictures
For i = 1 To oSection.ReportObjects.Count
'fully qualified croleobjects as craxdrt.crOleobject.. otherwise you will get the error - object variable not set
' if it is a CrOleObject then
If oSection.ReportObjects(i).Kind = CRAXDRT.crOLEObject Then
'Set the pic1 object to the Ole Report object
Set pic1 = oSection.ReportObjects(i)
End If
Next i

'view the report
CrystalActiveXReportViewer1.ReportSource = Report
CrystalActiveXReportViewer1.ViewReport

End Sub


'section format event:
'this event fires every time this section is generated by the report.
Private Sub oSection_format(ByVal pFormattingInfo As Object)

'load the image. this can be done dynamically if desired.
Set pic1.FormattedPicture = LoadPicture(App.Path + "\test.bmp")

End Sub


Private Sub Form_Resize()

CrystalActiveXReportViewer1.Top = 0
CrystalActiveXReportViewer1.Left = 0
CrystalActiveXReportViewer1.Height = ScaleHeight
CrystalActiveXReportViewer1.Width = ScaleWidth

End Sub

writeprocessmemory和readprocessmemory

範例1:
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Integer
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Const PROCESS_ALL_ACCESS = &H1F0FFF
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long


Private Sub TmPointer_Timer()
Dim hwn As Long
Dim pid As Long
Dim pHandle As Long
Dim Hp As Long
Dim Mp As Long
Dim Add As Long
Dim cde As Long


hwn = FindWindow(vbNullString, "MapleStory")
If hwn = 0 Then
Label1.Caption = "外掛未連接"
Else
Label1.Caption = "外掛連接成功"
End If
GetWindowThreadProcessId hwn, pid
pHandle = OpenProcess(PROCESS_ALL_ACCESS, False, pid)

ReadProcessMemory pHandle, ByVal &HE05D14, Add, 4, ByVal 0& '讀取Add
WriteProcessMemory pHandle, ByVal Add + &H50, 20, 1, ByVal 0& '寫入HP警告值20
WriteProcessMemory pHandle, ByVal Add + &H54, 20, 1, ByVal 0& '寫入MP警告值20
ReadProcessMemory pHandle, ByVal &HE05FB8, cde, 4, ByVal 0&
ReadProcessMemory pHandle, ByVal cde + &H214C, Hp, 4, ByVal 0& '讀取Add+HP偏移值
ReadProcessMemory pHandle, ByVal cde + &H2150, Mp, 4, ByVal 0& '讀取Add+MP偏移值
CloseHandle pHandle


lblHP.Caption = Hp
lblMP.Caption = Mp

End Sub


範例2: 參考引用
writeprocessmemory和readprocessmemory的基本用法
搞了半天总算懂了writeprocessmemory和readprocessmemory的基本用法
代码如下
Private Sub Command1_Click()
Dim StrLength As Long, Rtn As Long, hProcess As Long, WriteStr As String
Dim GetStr As String
Dim i As Long
    hProcess = OpenProcess(PROCESS_ALL_ACCESS, False, CLng(Text1.Text))
    WriteStr = Text2.Text
    StrLength = LenB(WriteStr)
    i = VirtualAllocEx(hProcess, ByVal 0&, StrLength, MEM_COMMIT, PAGE_READWRITE)
    Debug.Print Rtn
    Debug.Print WriteProcessMemory(hProcess, ByVal i, ByVal StrPtr(WriteStr), LenB(WriteStr), 0)
    GetStr = Space(LenB(WriteStr) \ 2)
    Debug.Print ReadProcessMemory(hProcess, ByVal i, ByVal StrPtr(GetStr), LenB(WriteStr), 0)
    MsgBox GetStr
End Sub
writestr是要写入的字符串。
代码是写入字符串然后读取。

Sql Server删除主键和重建主键

引用來源
--

在我們發佈產品過程中，有的時候需要修改某些表的主鍵，但是又不能在企業管理器中直接修改，必需寫sql語句，
這改如何處理呢？   可以先刪除主鍵，再新建主鍵 ,  下面舉一個詳細的例子：

create table abcd
(
  a char(10) not null,
  b char(10) not null primary key(a,b),
  c char(10) null,
  d char(10) null
)

一個存在的表 abcd ,主鍵為 a+b ,  現在想把 a+b+c 三列修改為主鍵

 1.   刪除主鍵：
Declare @Pk varChar(100);
Select @Pk=Name from sysobjects where Parent_Obj=OBJECT_ID('abcd') and xtype='PK';
if @Pk is not null
begin
     exec('Alter table abcd Drop '+ @Pk)  --刪除原主鍵
 end

2. 把所有主鍵設為不能為空
alter table abcd alter column c char(10) not null
 
3.  重建主鍵：
ALTER Table abcd ADD CONSTRAINT pk_abcd   PRIMARY KEY (a, b, c )

code 128 set A,B,C 規則

Code 128 Barcode Font
---
很完整又詳細喔!!
應該可以掌握了
code 128 真是複雜呀...

C128Tools & Visual Basic

code 128 barcodes in your custom programs

內有:
Code 128 code set A
Code 128 code set B
Code 128 code set C
的檢查碼算法

ASCII (and Extended ASCII)

Barcode編碼及識別: Code39 & Code128

Barcode編碼及識別: Code39 & Code128

C# 条形码 生成函数 code128

C# 条形码 生成函数 (Code 128 标准参考:GB/T 18347-2001)

水晶报表中用Code128制作条型码的方法

水晶报表中用Code128制作条型码的方法
--
Function fncGetCd128SetB ( strIn As string ) As String
 
    Dim intLoop As Number
    Dim intPosition as Number
    Dim intTotalVal as Number
    Dim strOut as String
    Dim strSpChr as String
    Dim strEndChr as String
    Dim intEndNo as Number
 
    strOut = ""
 
    for  intLoop = 0 to Len(strIn) - 1
        intPosition = intLoop + 1
        strSpChr = Mid(strIn, intPosition, 1)
        intTotalVal = intTotalVal + (Asc(strSpChr) - 32) * intPosition
    next
 
    intTotalVal = intTotalVal + 104
 
    intTotalVal = intTotalVal mod 103
 
    If intTotalVal >= 95 Then
        Select Case intTotalVal
            Case 95
                strEndChr = "Ã"
            Case 96
                strEndChr = "Ä"
            Case 97
                strEndChr = "Å"
            Case 98
                strEndChr = "Æ"
            Case 99
                strEndChr = "Ç"
            Case 100
                strEndChr = "È"
            Case 101
                strEndChr = "É"
            Case 102
                strEndChr = "Ê"
        End Select
    Else
        intTotalVal = intTotalVal + 32
        strEndChr = Chr(intTotalVal)
    End If

    fncGetCd128SetB = "Ì" + strIn + strEndChr + "Î"

End Function

Visual Basic 6.0 中發布 Crystal Report 9

在client 必須要有底下檔,即可正常顯示報表:
keycode.dll
crqe.dll
CRAnalyzer.dll
craxddrt9.dll
craxdrt9.dll
crviewer9.dll
Emfgen.dll
swebrs.dll
crtslv.dll
sviewhlp.dll
ExportModeller.dll

EAN128/CODE128码生成

EAN128/CODE128码生成

code 128 使用方法

條碼字型下載
 

引用:有關barcode code-128 
---

（八）128碼

128碼是個功能強大卻頗複雜的條碼系統，約於1981年開始被採用。其編碼特性如下：

1.資料可為ASCII 0∼127之任何字元，長度最長30個資料。
2.編碼結構為〔起始碼＋資料碼＋終止碼＋檢查碼〕，其中檢查碼可有可無，通常不加。
3.有三類編碼方式：
A類：ASCII 0∼95。
B類：ASCII 32∼127。
C類：數字00∼99。
其中ASCII 0∼31對應編碼索引為64∼95，ASCII 32∼95對應編碼索引為0∼63，ASCII 96∼127對應編碼索引為64∼95，C類數字直接對應至編碼索引。各類尚有特殊編碼索引值如下：
A類：F3=96、F2=97、Shift=98、Code C=99、Code B=100、F4=101、F1=102
B類：F3=96、F2=97、Shift=98、Code C=99、F4=100、Code A=101、F1=102
C類：Code B=100、Code A=101、F1=102
4.起始碼有11線，用以決定一開始的編碼類型，各類型的起始碼為：
A類 = 11010000100
B類 = 11010010000
C類 = 11010011100
終止碼有13線，固定為1100011101011。
5.各編碼索引對應之編碼值如下，0表白線，1表黑線，各佔11條線：
00 11011001100
01 11001101100
02 11001100110
... (以下略, 你已有字型了, 應該按此線條列印)
99 10111011110
100 10111011110
101 11101011110
102 11110101110
6.檢查碼的計算方式103加上各資料的編碼索引值乘上位置值的總和，再除以103取餘數。假設資料編碼索引值依次為ABC，則檢查碼 = (103 + A*1 + B*2 + C*3) % 103。計算出檢查碼後，即視為編碼索引值進行編碼。
7.特殊資料碼意義為：
F1∼F4 = 同按下F1∼F4鍵
Shift = 同按下Shift鍵
Code A = 編碼類別改成A類
Code B = 編碼類別改成B類
Code C = 編碼類別改成C類

由於128碼可以中途轉變編碼類別，因此同一個資料可能有多個編碼方式，如何將編碼長度縮到最小，便成為一項考驗。以下係我們經過分析後，所得到的演算法，可使得編碼長度縮到最小：

1.決定起始碼
(1)一開始數字連續4個以上時，使用C類。
(2)先遇上ASCII 0∼31者，使用A類，先遇上ASCII 96∼127者，使用B類。都遇不上，一律採用A類。
2.中途轉碼考慮
A、B類 -
(1)數字6個以上時，改用C類。
(2)遇上ASCII 0∼31者，改用A類，遇上ASCII 96∼127，改用B類。
C類 -
(1)只剩0∼1個數字時，往後找(2)的情況，若無，一律使用A類。
(2)遇上ASCII 0∼31者，改用A類，遇上ASCII 96∼127，改用B類。

參考:code128編碥必要知識

code 128 barcodes in your custom programs

vb6 crystal report 列印份數

strDeviceName = Printer.DeviceName
strDriverName =Printer.DriverName
strPort = Printer.Port


FromPage = Val(txtFrom.Text)
ToPage = Val(txtTo.Text)
NoCopies = Val(txtCopies.Text)  '***列印份數

MyReport.SelectPrinter strDriverName, strDeviceName, strPort
MyReport.PrintOut False, NoCopies, , FromPage, ToPage

vb6 crystal report

Dim Report As New CRAXDDRT.Report
Dim App As New CRAXDDRT.Application



Private Sub Command1_Click()

 Set Report = App.OpenReport("C:\SBWBWIN\Report1.rpt")
    Report.Database.Tables(1).Location = "C:\sbwbwin\NewDatabase.mdb"
    CRViewer.ReportSource = Report
    CRViewer.ViewReport
    CRViewer.Zoom (100)
    Screen.MousePointer = vbDefault
    'CRViewer.PrintReport
    Report.PrintOut False, nocopies
   
End Sub

Crystal Reports for vb6

Programatically passing parameters from VB to crystal reports using CRAXDRT

允許win7開放ICMP(Ping)回應

允許win7開放ICMP(Ping)回應