* DataLib.PRG -- VFP 数据基础函数库
*
* 代码编写: fireghost57
* 维护日期: 2013.12.12
*
*----------------------------------------------------------------------------*
*
* 工作表处理函数
*
*----------------------------------------------------------------------------*
* 打开工作簿
* oExcel 变量需要传递源地址,写法为"@oExcel"
Function openExcel(oExcel,lcWorkbookPath)
local lbResult
try
oExcel = Createobject("Excel.application")
oExcel.DisplayAlerts = .F. && 关闭警告信息
catch
messagebox("请检查是否已安装 Microsoft Excel 应用程序",0,"提示")
lbResult = .F.
endtry
try
oExcel.Workbooks.Open(lcWorkbookPath)
lbResult = .T.
catch
messagebox("无法打开工作簿["+ lcWorkbookPath +"],请检查路径是否正确",0,"提示")
lbResult = .F.
endtry
return lbResult
Endfunc
*----------------------------------------------------------------------------*
* 关闭工作簿
Function closeExcel(oExcel,lbSave)
local lbResult
try
oExcel.DisplayAlerts = .T. && 开启警告信息
if lbSave
oExcel.ActiveWorkbook.Save && 存盘
else
oExcel.ActiveWorkbook.Saved = .T. && 放弃存盘
endif
oExcel.Workbooks.Close
oExcel.Quit
release oExcel
lbResult = .T.
catch
lbResult = .F.
endtry
return lbResult
Endfunc
*----------------------------------------------------------------------------*
* 显示工作簿
Function showExcel(oExcel)
oExcel.Visible = .T.
Endfunc
*----------------------------------------------------------------------------*
* 检测工作表是否存在
Function isSheetExist(oExcel,lvSheetName)
local lbResult
try
oExcel.Worksheets(lvSheetName).Activate
oExcel.ActiveWorkbook.Saved = .T. && 放弃存盘
lbResult = .T.
catch
lbResult = .F.
endtry
return lbResult
Endfunc
*----------------------------------------------------------------------------*
* 清空工作表
Function cleanExcel(oExcel,lvSheetName,lnStartRow)
local lbResult
lbResult = .T.
try
local lnRowCount,lnIndex
lnRowCount = oExcel.Worksheets(lvSheetName).UsedRange.Rows.Count && 读取有效行数
for lnIndex = lnStartRow to lnRowCount
oExcel.Worksheets(lvSheetName).Rows(lnStartRow).Delete
endfor
oExcel.ActiveWorkbook.Save && 存盘
catch
messagebox("不存在工作表["+ lvSheetName +"]",0,"提示")
lbResult = .F.
endtry
return lbResult
Endfunc
*----------------------------------------------------------------------------*
* 获取有效行列数
Function countUsedRange(oExcel,lvSheetName,lcMode)
local lnResult
try
do case
case upper(lcMode) == "R"
lnResult = oExcel.Worksheets(lvSheetName).UsedRange.Rows.Count
case upper(lcMode) == "C"
lnResult = oExcel.Worksheets(lvSheetName).UsedRange.Columns.Count
endcase
catch
lnResult = 0
endtry
return lnResult
Endfunc
*----------------------------------------------------------------------------*
* 获取列位置
Function getColPos(oExcel,lvSheetName,lnRowNum,lnStart,lcValue)
local lnIndex,;
lnColCount
lnColCount = oExcel.Worksheets(lvSheetName).UsedRange.Columns.Count
for lnIndex = lnStart to lnColCount
tcValue = oExcel.Cells(lnRowNum,lnIndex).Value
try
tcValue = STR(tcValue)
catch
endtry
if upper(ALLTRIM(tcValue)) == upper(ALLTRIM(lcValue))
return lnIndex
endif
endfor
return 0
Endfunc
*----------------------------------------------------------------------------*
* 获取行位置
Function getRowPos(oExcel,lvSheetName,lnColNum,lnStart,lcValue)
local lnIndex,;
lnRowCount
lnRowCount = oExcel.Worksheets(lvSheetName).UsedRange.Rows.Count
for lnIndex = lnStart to lnRowCount
tcValue = oExcel.Cells(lnIndex,lnColNum).Value
try
tcValue = STR(tcValue)
catch
endtry
if upper(ALLTRIM(tcValue)) == upper(ALLTRIM(lcValue))
return lnIndex
endif
endfor
return 0
Endfunc
*----------------------------------------------------------------------------*
* 插入行
Function rowInsert(oExcel,lvSheetName,lnStartRow)
local lbResult
try
oExcel.Worksheets(lvSheetName).Rows(lnStartRow).Insert
lbResult = .T.
catch
lbResult = .F.
endtry
return lbResult
Endfunc
*----------------------------------------------------------------------------*
* 删除行
Function rowDelete(oExcel,lvSheetName,lnStartRow)
local lbResult
try
oExcel.Worksheets(lvSheetName).Rows(lnStartRow).Delete
lbResult = .T.
catch
lbResult = .F.
endtry
return lbResult
Endfunc
*----------------------------------------------------------------------------*
* 写入单元格
* lvValue 若是长数字字符串,需要在字符串前加"'"再赋值,如"'123456789012345"
Function writeCell(oExcel,lvSheetName,lnRow,lnCol,lvValue)
local lbResult
try
oExcel.Worksheets(lvSheetName).Cells(lnRow,lnCol).Value = lvValue
oExcel.Worksheets(lvSheetName).Columns.AutoFit && 自动调整列宽
lbResult = .T.
catch
lbResult = .F.
endtry
return lbResult
Endfunc
*----------------------------------------------------------------------------*
* 读取单元格
Function readCell(oExcel,lvSheetName,lnRow,lnCol)
local lvValue
try
lvValue = oExcel.Worksheets(lvSheetName).Cells(lnRow,lnCol).Value
catch
lvValue = .NULL.
endtry
return lvValue
Endfunc
*----------------------------------------------------------------------------*
* 判断合并单元格
Function isMergeCell(oExcel,lvSheetName,lnRow,lnCol)
local lbResult
try
lbResult = oExcel.Worksheets(lvSheetName).Cells(lnRow,lnCol).MergeCells
catch
lbResult = .F.
endtry
return lbResult
Endfunc
*----------------------------------------------------------------------------*
* 获取合并单元格行列数
Function countMergeCell(oExcel,lvSheetName,lnRow,lnCol,lcMode)
local lnResult
try
do case
case upper(lcMode) == "R"
lnResult = oExcel.Worksheets(lvSheetName).Cells(lnRow,lnCol).MergeArea.Rows.Count
case upper(lcMode) == "C"
lnResult = oExcel.Worksheets(lvSheetName).Cells(lnRow,lnCol).MergeArea.Columns.Count
endcase
catch
lnResult = 0
endtry
return lnResult
Endfunc
*----------------------------------------------------------------------------*
* 设置合并单元格
* 需要激活工作表
Function mergeCell(oExcel,lvSheetName,lnStRow,lnStCol,lnEdRow,lnEdCol)
local lbResult
try
oExcel.Worksheets(lvSheetName).Activate
With oExcel.ActiveSheet.Range(oExcel.Cells(lnStRow,lnStCol),oExcel.Cells(lnEdRow,lnEdCol))
.MergeCells = .T.
EndWith
lbResult = .T.
catch
lbResult = .F.
endtry
return lbResult
Endfunc
*----------------------------------------------------------------------------*
* 拆分合并单元格
* 需要激活工作表
Function splitCell(oExcel,lvSheetName,lnMgRow,lnMgCol)
local lbResult
try
oExcel.Worksheets(lvSheetName).Activate
With oExcel.ActiveSheet.Cells(lnMgRow,lnMgCol)
if .MergeCells
.UnMerge
lbResult = .T.
else
lbResult = .F.
endif
EndWith
catch
lbResult = .F.
endtry
return lbResult
Endfunc
*----------------------------------------------------------------------------*
* 设置边框
* 需要激活工作表
Function setBorder(oExcel,lvSheetName,lnStRow,lnStCol,lnEdRow,lnEdCol,lnSide,lnLineStyle,lnWeight)
local lbResult
try
oExcel.Worksheets(lvSheetName).Activate
With oExcel.ActiveSheet.Range(oExcel.Cells(lnStRow,lnStCol),oExcel.Cells(lnEdRow,lnEdCol))
.BorderS(lnSide).LineStyle = lnLineStyle && 设置边框样式
.BorderS(lnSide).Weight = lnWeight && 设置行底边框
EndWith
lbResult = .T.
catch
lbResult = .F.
endtry
return lbResult
Endfunc
*----------------------------------------------------------------------------*
*
* 文档处理函数
*
*----------------------------------------------------------------------------*
* 打开文档
* oWord 变量需要传递源地址,写法为"@oWord"
Function openWord(oWord,lcDocumentPath)
local lbResult
try
oWord = Createobject("Word.application")
oWord.DisplayAlerts = .F. && 关闭警告信息
catch
messagebox("请检查是否已安装 Microsoft Word 应用程序",0,"提示")
lbResult = .F.
endtry
try
oWord.Documents.Open(lcDocumentPath)
lbResult = .T.
catch
messagebox("无法打开文档["+ lcDocumentPath +"],请检查路径是否正确",0,"提示")
lbResult = .F.
endtry
return lbResult
Endfunc
*----------------------------------------------------------------------------*
* 关闭文档
Function closeWord(oWord,lbSave)
local lbResult
try
oWord.DisplayAlerts = .T. && 开启警告信息
if lbSave
oWord.ActiveDocument.Save && 存盘
else
oWord.ActiveDocument.Saved = .T. && 放弃存盘
endif
oWord.Documents.Close
oWord.Quit
release oWord
lbResult = .T.
catch
lbResult = .F.
endtry
return lbResult
Endfunc
*----------------------------------------------------------------------------*
* 显示文档
Function showWord(oWord)
oWord.Visible = .T.
Endfunc
*----------------------------------------------------------------------------*
* 检测文档是否存在
Function isDocumentExist(oWord,lvDocumentName)
local lbResult
try
oWord.Documents(lvDocumentName).Activate
oWord.ActiveDocument.Saved = .T. && 放弃存盘
lbResult = .T.
catch
lbResult = .F.
endtry
return lbResult
Endfunc
*----------------------------------------------------------------------------*
* 获取文本长度
Function getTextLen(oWord,lvDocumentName,lnParagraphNum)
local lnLength,;
lnPos1,lnPos2
try
oWord.Documents(lvDocumentName).Activate
lnPos1 = oWord.ActiveDocument.Paragraphs(lnParagraphNum).Range.Start
lnPos2 = oWord.ActiveDocument.Paragraphs(lnParagraphNum).Range.End
lnLength = lnPos2 - lnPos1 - 1
catch
lnLength = -1
endtry
return lnLength
Endfunc
*----------------------------------------------------------------------------*
* 写入文本
Function writeText(oWord,lvDocumentName,lnParagraphNum,lcText)
local lbResult
try
oWord.Documents(lvDocumentName).Activate
oWord.ActiveDocument.Paragraphs(lnParagraphNum).Range.Text = "" + CHR(13) + CHR(10)
oWord.ActiveDocument.Paragraphs(lnParagraphNum).Range.Text = lcText + CHR(13) + CHR(10)
lbResult = .T.
catch
lbResult = .F.
endtry
return lbResult
Endfunc
*----------------------------------------------------------------------------*
* 读取文本
Function readText(oWord,lvDocumentName,lnParagraphNum)
local lcText
try
oWord.Documents(lvDocumentName).Activate
lcText = oWord.ActiveDocument.Paragraphs(lnParagraphNum).Range.Text
catch
lcText = ""
endtry
return lcText
Endfunc
*----------------------------------------------------------------------------*
* 获取文档统计
* lnMode = 0 字数
* lnMode = 1 行数
* lnMode = 2 页数
* lnMode = 3 字符数(不计空格)
* lnMode = 4 段落数
* lnMode = 5 字符数(计空格)
* lnMode = 6 中文字符和朝鲜语单词
Function countDocument(oWord,lvDocumentName,lnMode)
local lnResult
try
oWord.Documents(lvDocumentName).Activate
lnResult = oWord.ActiveDocument.ComputeStatistics(lnMode)
catch
lnResult = -1
endtry
return lnResult
Endfunc
*----------------------------------------------------------------------------*
* 添加表格
* 在段落前添加新表格,可选择插入或覆盖选中段落
Function tableAdd(oWord,lvDocumentName,lnParagraphNum,lnRow,lnCol,lbAddNew)
local lbResult,;
lnPos1,lnPos2,;
loRange
try
oWord.Documents(lvDocumentName).Activate
* 在段落添加或覆盖新表格
if lbAddNew
loRange = oWord.ActiveDocument.Paragraphs(lnParagraphNum).Range
oWord.ActiveDocument.Paragraphs.Add(loRange)
endif
lnPos1 = oWord.ActiveDocument.Paragraphs(lnParagraphNum).Range.Start
lnPos2 = oWord.ActiveDocument.Paragraphs(lnParagraphNum).Range.End
loRange = oWord.ActiveDocument.Range(lnPos1,lnPos2)
oWord.ActiveDocument.Tables.Add(loRange,lnRow,lnCol)
lbResult = .T.
catch
lbResult = .F.
endtry
return lbResult
Endfunc
*----------------------------------------------------------------------------*
* 删除表格
Function tableDel(oWord,lvDocumentName,lnTableNum)
local lbResult
try
oWord.Documents(lvDocumentName).Activate
oWord.ActiveDocument.Tables(lnTableNum).Delete
lbResult = .T.
catch
lbResult = .F.
endtry
return lbResult
Endfunc
*----------------------------------------------------------------------------*
* 写表格单元格
Function writeTable(oWord,lvDocumentName,lnTableNum,lnRow,lnCol,lvValue)
local lbResult
try
oWord.Documents(lvDocumentName).Activate
oWord.ActiveDocument.Tables(lnTableNum).Cell(lnRow,lnCol).Range.Text = lvValue
oWord.ActiveDocument.Tables(lnTableNum).AllowAutoFit = .T. && 自动调整列宽
lbResult = .T.
catch
lbResult = .F.
endtry
return lbResult
Endfunc
*----------------------------------------------------------------------------*
* 读表格单元格
Function readTable(oWord,lvDocumentName,lnTableNum,lnRow,lnCol)
local lvValue
try
oWord.Documents(lvDocumentName).Activate
lvValue = oWord.ActiveDocument.Tables(lnTableNum).Cell(lnRow,lnCol).Range.Text
catch
lvValue = .NULL.
endtry
* 处理结尾字符
lvValue = STUFF(lvValue,AT(CHR(13),lvValue),1,SPACE(1))
lvValue = STUFF(lvValue,AT(CHR(7),lvValue),1,SPACE(1))
lvValue = ALLTRIM(lvValue)
return lvValue
Endfunc
*----------------------------------------------------------------------------*
* 统计表格行列
Function countTable(oWord,lvDocumentName,lnTableNum,lcMode)
local lnResult
try
oWord.Documents(lvDocumentName).Activate
do case
case upper(lcMode) == "R"
lnResult = oWord.ActiveDocument.Tables(lnTableNum).Rows.Count
case upper(lcMode) == "C"
lnResult = oWord.ActiveDocument.Tables(lnTableNum).Columns.Count
endcase
catch
lnResult = 0
endtry
return lnResult
Endfunc
*----------------------------------------------------------------------------*
* 统计当前单元格行列
* lcMode = "CR" 当前行数(CurRow)
* lcMode = "CC" 当前列数(CurCol)
* lcMode = "PR" 当前行位置(PosRow)
* lcMode = "PC" 当前列位置(PosCol)
Function countTableCell(oWord,lvDocumentName,lnTableNum,lnRow,lnCol,lcMode)
local lnResult
try
oWord.Documents(lvDocumentName).Activate
oWord.ActiveDocument.Tables(lnTableNum).Cell(lnRow,lnCol).Select
* 返回结果
do case
case upper(lcMode) == "CR"
lnResult = oWord.Selection.Information(15) && 当前行数
case upper(lcMode) == "CC"
lnResult = oWord.Selection.Information(18) && 当前列数
case upper(lcMode) == "PR"
lnResult = oWord.Selection.Information(13) && 当前行位置
case upper(lcMode) == "PC"
lnResult = oWord.Selection.Information(16) && 当前列位置
endcase
catch
lnResult = 0
endtry
return lnResult
Endfunc
*----------------------------------------------------------------------------*
* 统计表格数
Function countTableNum(oWord,lvDocumentName)
return oWord.Documents(lvDocumentName).Tables.Count
Endfunc
*----------------------------------------------------------------------------*
* 设置表格合并单元格
Function mergeTableCell(oWord,lvDocumentName,lnTableNum,lnStRow,lnStCol,lnEdRow,lnEdCol)
local lbResult
try
oWord.Documents(lvDocumentName).Activate
WITH oWord.ActiveDocument.Tables(lnTableNum)
.Cell(lnStRow,lnStCol).Merge(.Cell(lnEdRow,lnEdCol))
ENDWITH
lbResult = .T.
catch
lbResult = .F.
endtry
return lbResult
Endfunc
*----------------------------------------------------------------------------*
* 拆分表格合并单元格
Function splitTableCell(oWord,lvDocumentName,lnTableNum,lnMgRow,lnMgCol,lnSpRow,lnSpCol)
local lbResult
try
oWord.Documents(lvDocumentName).Activate
WITH oWord.ActiveDocument.Tables(lnTableNum)
.Cell(lnMgRow,lnMgCol).Split(lnSpRow,lnSpCol)
ENDWITH
lbResult = .T.
catch
lbResult = .F.
endtry
return lbResult
Endfunc
*----------------------------------------------------------------------------*
*
* 数据表处理函数
*
*----------------------------------------------------------------------------*
* 获取数据表指定字段中不重复内容并保存到数组中
* laFoundList 变量需要传递源地址,写法为"@laFoundList"
* 求数组长度用函数"ALEN()"
Function getDataList(lcDataTable,lcFieldName,laFoundList)
local lnIndex,;
lnRowCount,;
lnFoundCount,lcCurValue,;
lbCanAddOn
use &lcDataTable
count to lnRowCount && 统计数据表记录数
dimen laFieldList[lnRowCount]
lnFoundCount = 0
scan
lcCurValue = alltrim(&lcFieldName)
* 核对清单是否有重复内容
if not empty(lcCurValue)
lbCanAddOn = .T.
for lnIndex = 1 to lnFoundCount
* 有重复内容则不允许添加
if laFieldList[lnIndex] == lcCurValue
lbCanAddOn = .F.
endif
endfor
* 添加内容
if lbCanAddOn
lnFoundCount = lnFoundCount + 1
laFieldList[lnFoundCount] = lcCurValue
endif
endif
endscan
dimen laFoundList[lnFoundCount]
for lnIndex = 1 to lnFoundCount
laFoundList[lnIndex] = laFieldList[lnIndex]
endfor
return lnFoundCount
Endfunc
*----------------------------------------------------------------------------*
*
* 日期处理函数
*
*----------------------------------------------------------------------------*
* 获取日期字符串
FUNCTION getDateStr(lvDate)
local lcResult
lcResult = lvDate
* 日期转字符
try
lcResult = DTOC(lcResult)
catch
endtry
* 数字转字符
try
lcResult = STR(lcResult)
catch
endtry
* 处理长度
try
lcResult = ALLTRIM(SUBSTR(lcResult,1,10))
catch
endtry
tCentury = SUBSTR(ALLTRIM(STR(YEAR(DATE()))),1,2)
try
tCHR = "."
if AT(tCHR,lcResult) == 3
lcResult = tCentury + lcResult
endif
DO WHILE AT(tCHR,lcResult) > 0
lcResult = STUFF(lcResult,AT(tCHR,lcResult),1,"-")
ENDDO
catch
endtry
try
tCHR = "/"
if AT(tCHR,lcResult) == 3
lcResult = tCentury + lcResult
endif
DO WHILE AT(tCHR,lcResult) > 0
lcResult = STUFF(lcResult,AT(tCHR,lcResult),1,"-")
ENDDO
catch
endtry
return lcResult
ENDFUNC
* 当前日期转换为字符串
FUNCTION getToday()
return TRANSFORM(VAL(DTOS(DATE())))
ENDFUNC
*----------------------------------------------------------------------------*
* 计算指定日期当月最大天数
FUNCTION getEndOfMonth(ldDate)
local lcYear,lcMonth,;
fl_lnIndex
lcYear = alltrim(str(year(ldDate)))
lcMonth = alltrim(str(month(ldDate)))
for fl_lnIndex = 31 to 28 step -1
if not empty(CTOD(lcYear + "." + lcMonth + "." + alltrim(str(fl_lnIndex))))
exit
endif
endfor
return fl_lnIndex
ENDFUNC
*----------------------------------------------------------------------------*
* 判断日期是否连续
FUNCTION isNextDay(ldDateNew,ldDateOld)
* 判断日期大小
if VAL(DTOS(ldDateNew)) <= VAL(DTOS(ldDateOld))
return .F.
endif
* 计算旧日期最大天
set date ansi && 设置日期格式为ASCII码, 否则 CTOD() 函数出错
for tnOldDateMaxDay = 31 to 28 step -1
if not empty(CTOD(alltrim(str(year(ldDateOld))) + "." + ;
alltrim(str(month(ldDateOld))) + "." + ;
alltrim(str(tnOldDateMaxDay))))
exit
endif
endfor
* 判断日期连续性
if VAL(DTOS(ldDateNew)) - VAL(DTOS(ldDateOld)) == 1
* 隔天
return .T.
else
* 隔月
if (year(ldDateNew) == year(ldDateOld) AND ;
month(ldDateNew) - month(ldDateOld) == 1 AND ;
day(ldDateNew) == 1 AND ;
day(ldDateOld) == tnOldDateMaxDay)
return .T.
endif
* 隔年
if (year(ldDateNew) - year(ldDateOld) == 1 AND ;
month(ldDateNew) == 1 AND day(ldDateNew) == 1 AND ;
month(ldDateOld) == 12 AND day(ldDateOld) == 31)
return .T.
endif
endif
return .F.
ENDFUNC
*----------------------------------------------------------------------------*
*
* 字符处理函数
*
*----------------------------------------------------------------------------*
* 数字转字符
FUNCTION numToDword(lnNum)
DECLARE INTEGER RtlMoveMemory IN kernel32 AS RtlCopyDword STRING @pDeststring, INTEGER @pVoidSource, INTEGER nLength
lcDword = SPACE(4)
RtlCopyDword(@lcDword, BITOR(lnNum,0), 4)
RETURN lcDword
ENDFUNC
*----------------------------------------------------------------------------*
* 字符转数字
FUNCTION dwordToNum(lcDword)
DECLARE INTEGER RtlMoveMemory IN kernel32 AS RtlCopyNum INTEGER @pDestNumeric, STRING @pVoidSource, INTEGER nLength
lnNum = 0
RtlCopyNum(@lnNum, lcDword, 8)
RETURN lnNum
ENDFUNC
*----------------------------------------------------------------------------*
* 获取字符串中字符
FUNCTION getChr(lcString)
return alltrim(Chrtran(lcString, "0123456789", ""))
ENDFUNC
*----------------------------------------------------------------------------*
* 获取字符串中数字
FUNCTION getInt(lcString)
return alltrim(Chrtran(lcString, Chrtran(lcString, "0123456789", ""), ""))
ENDFUNC
*----------------------------------------------------------------------------*
* 替换字符串中字符
FUNCTION replaceChar(lcString,lcFndChr,lcRplChr)
DO WHILE AT(lcFndChr,lcString) > 0
lcString = STUFF(lcString,AT(lcFndChr,lcString),LEN(lcFndChr),REPLICATE(SUBSTR(lcRplChr,1,1),LEN(lcFndChr)))
ENDDO
return lcString
ENDFUNC
*----------------------------------------------------------------------------*
* 获取分隔符切分内容,判断是否为空值可用函数 IsNull()
FUNCTION getSplit(lcString,lcDlmtChr,lnPos)
local lnSplit,lcResult
lcString = UPPER(ALLTRIM(lcString))
for lnPos = 1 to lnPos
lnSplit = AT(lcDlmtChr,lcString)
lcResult = IIF(lnSplit<>0, SUBSTR(lcString,1,lnSplit-1), lcString)
lcString = IIF(lnSplit<>0, SUBSTR(lcString,lnSplit+1,LEN(lcString)), .NULL.)
endfor
return lcResult
ENDFUNC
*----------------------------------------------------------------------------*
* 字符串截取函数,判断是否为空值可用函数 IsNull()
* 可根据设定的起始和终止字符截取两者之间的字符串,且可以设置要截取的位置
FUNCTION trimWord(lcString,lcSrtMrk,lcEndMrk,lnPos)
local fl_lnIndex
for fl_lnIndex = 1 to lnPos
lnAT_A = AT(lcSrtMrk,lcString)
lnAT_B = AT(lcEndMrk,lcString)
if lnAT_B - lnAT_A > 1
lcPartStr = SUBSTR(lcString,lnAT_A+1,lnAT_B - lnAT_A - 1)
lnStrLen = LEN(lcString) - (lnAT_B - lnAT_A + 1)
lcString = SUBSTR(lcString,lnAT_B+1,lnStrLen)
if fl_lnIndex == lnPos
return lcPartStr
endif
else
return .NULL.
endif
endfor
ENDFUNC
*----------------------------------------------------------------------------*
*
* 内容处理函数
*
*----------------------------------------------------------------------------*
* 获取中文井号
Function getWellName(lcWellCode)
local lcWellName,;
lcChrS,lcChrT
lcWellCode = UPPER(ALLTRIM(lcWellCode))
lnSplit = AT("-",lcWellCode)
lcPartL = IIF(lnSplit<>0, SUBSTR(lcWellCode,1,lnSplit-1), lcWellCode)
lcPartR = IIF(lnSplit<>0, SUBSTR(lcWellCode,lnSplit+1,LEN(lcWellCode)), "")
lcWellName = ""
* 处理井号左片段
if LEN(lcPartL) > 0
lcChrS = "B分"
lcChrT = "州分"
do while AT(lcChrS,lcPartL) <> 0
lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)
enddo
lcChrS = "S北"
lcChrT = "升北"
do while AT(lcChrS,lcPartL) <> 0
lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)
enddo
lcChrS = "Z分"
lcChrT = "肇分"
do while AT(lcChrS,lcPartL) <> 0
lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)
enddo
lcChrS = "BF"
lcChrT = "州扶"
do while AT(lcChrS,lcPartL) <> 0
lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)
enddo
lcChrS = "FF"
lcChrT = "芳扶"
do while AT(lcChrS,lcPartL) <> 0
lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)
enddo
lcChrS = "FP"
lcChrT = "芳葡"
do while AT(lcChrS,lcPartL) <> 0
lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)
enddo
lcChrS = "TD"
lcChrT = "太东"
do while AT(lcChrS,lcPartL) <> 0
lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)
enddo
lcChrS = "ZF"
lcChrT = "肇扶"
do while AT(lcChrS,lcPartL) <> 0
lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)
enddo
lcChrS = "ZP"
lcChrT = "肇葡"
do while AT(lcChrS,lcPartL) <> 0
lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)
enddo
lcChrS = "B"
lcChrT = "州"
do while AT(lcChrS,lcPartL) <> 0
lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)
enddo
lcChrS = "E"
lcChrT = "升扶"
do while AT(lcChrS,lcPartL) <> 0
lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)
enddo
lcChrS = "F"
lcChrT = "芳"
do while AT(lcChrS,lcPartL) <> 0
lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)
enddo
lcChrS = "H"
lcChrT = "卫"
do while AT(lcChrS,lcPartL) <> 0
lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)
enddo
lcChrS = "K"
lcChrT = "太"
do while AT(lcChrS,lcPartL) <> 0
lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)
enddo
lcChrS = "L"
lcChrT = "永"
do while AT(lcChrS,lcPartL) <> 0
lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)
enddo
lcChrS = "M"
lcChrT = "密闭取芯井"
do while AT(lcChrS,lcPartL) <> 0
lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)
enddo
lcChrS = "P"
lcChrT = "葡"
do while AT(lcChrS,lcPartL) <> 0
lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)
enddo
lcChrS = "Q"
lcChrT = "升气"
do while AT(lcChrS,lcPartL) <> 0
lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)
enddo
lcChrS = "S"
lcChrT = "升"
do while AT(lcChrS,lcPartL) <> 0
lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)
enddo
lcChrS = "U"
lcChrT = "台"
do while AT(lcChrS,lcPartL) <> 0
lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)
enddo
lcChrS = "X"
lcChrT = "徐"
do while AT(lcChrS,lcPartL) <> 0
lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)
enddo
lcChrS = "Z"
lcChrT = "肇"
do while AT(lcChrS,lcPartL) <> 0
lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)
enddo
lcWellName = lcPartL
endif
* 处理井号右片段
if LEN(lcPartR) > 0
lcChrS = "CP"
lcChrT = "侧平"
do while AT(lcChrS,lcPartR) <> 0
lcPartR = STUFF(lcPartR,AT(lcChrS,lcPartR),LEN(lcChrS),lcChrT)
enddo
lcChrS = "CS"
lcChrT = "侧斜"
do while AT(lcChrS,lcPartR) <> 0
lcPartR = STUFF(lcPartR,AT(lcChrS,lcPartR),LEN(lcChrS),lcChrT)
enddo
lcChrS = "J"
do while AT(lcChrS,lcPartR) <> 0
if AT(lcChrS,lcPartR) == LEN(lcPartR)
lcChrT = "加"
else
lcChrT = "检"
endif
lcPartR = STUFF(lcPartR,AT(lcChrS,lcPartR),LEN(lcChrS),lcChrT)
enddo
lcChrS = "P"
lcChrT = "平"
do while AT(lcChrS,lcPartR) <> 0
lcPartR = STUFF(lcPartR,AT(lcChrS,lcPartR),LEN(lcChrS),lcChrT)
enddo
lcChrS = "S"
lcChrT = "斜"
do while AT(lcChrS,lcPartR) <> 0
lcPartR = STUFF(lcPartR,AT(lcChrS,lcPartR),LEN(lcChrS),lcChrT)
enddo
lcWellName = lcPartL + "-" + lcPartR
endif
return lcWellName
Endfunc
*----------------------------------------------------------------------------*
* 获取代码井号
Function getWellCode(lcWellName)
local lcWellCode,;
lcChrS,lcChrT
lcWellCode = lcWellName
lcChrS = "州分"
lcChrT = "B分"
do while AT(lcChrS,lcWellCode) <> 0
lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)
enddo
lcChrS = "升北"
lcChrT = "S北"
do while AT(lcChrS,lcWellCode) <> 0
lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)
enddo
lcChrS = "肇分"
lcChrT = "Z分"
do while AT(lcChrS,lcWellCode) <> 0
lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)
enddo
lcChrS = "州扶"
lcChrT = "BF"
do while AT(lcChrS,lcWellCode) <> 0
lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)
enddo
lcChrS = "芳扶"
lcChrT = "FF"
do while AT(lcChrS,lcWellCode) <> 0
lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)
enddo
lcChrS = "芳葡"
lcChrT = "FP"
do while AT(lcChrS,lcWellCode) <> 0
lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)
enddo
lcChrS = "太东"
lcChrT = "TD"
do while AT(lcChrS,lcWellCode) <> 0
lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)
enddo
lcChrS = "肇扶"
lcChrT = "ZF"
do while AT(lcChrS,lcWellCode) <> 0
lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)
enddo
lcChrS = "肇葡"
lcChrT = "ZP"
do while AT(lcChrS,lcWellCode) <> 0
lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)
enddo
lcChrS = "州"
lcChrT = "B"
do while AT(lcChrS,lcWellCode) <> 0
lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)
enddo
lcChrS = "升扶"
lcChrT = "E"
do while AT(lcChrS,lcWellCode) <> 0
lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)
enddo
lcChrS = "芳"
lcChrT = "F"
do while AT(lcChrS,lcWellCode) <> 0
lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)
enddo
lcChrS = "卫"
lcChrT = "H"
do while AT(lcChrS,lcWellCode) <> 0
lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)
enddo
lcChrS = "太"
lcChrT = "K"
do while AT(lcChrS,lcWellCode) <> 0
lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)
enddo
lcChrS = "永"
lcChrT = "L"
do while AT(lcChrS,lcWellCode) <> 0
lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)
enddo
lcChrS = "密闭取芯井"
lcChrT = "M"
do while AT(lcChrS,lcWellCode) <> 0
lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)
enddo
lcChrS = "葡"
lcChrT = "P"
do while AT(lcChrS,lcWellCode) <> 0
lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)
enddo
lcChrS = "升气"
lcChrT = "Q"
do while AT(lcChrS,lcWellCode) <> 0
lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)
enddo
lcChrS = "升"
lcChrT = "S"
do while AT(lcChrS,lcWellCode) <> 0
lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)
enddo
lcChrS = "台"
lcChrT = "U"
do while AT(lcChrS,lcWellCode) <> 0
lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)
enddo
lcChrS = "徐"
lcChrT = "X"
do while AT(lcChrS,lcWellCode) <> 0
lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)
enddo
lcChrS = "肇"
lcChrT = "Z"
do while AT(lcChrS,lcWellCode) <> 0
lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)
enddo
lcChrS = "侧平"
lcChrT = "CP"
do while AT(lcChrS,lcWellCode) <> 0
lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)
enddo
lcChrS = "侧斜"
lcChrT = "CS"
do while AT(lcChrS,lcWellCode) <> 0
lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)
enddo
lcChrS = "加"
lcChrT = "J"
do while AT(lcChrS,lcWellCode) <> 0
lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)
enddo
lcChrS = "检"
lcChrT = "J"
do while AT(lcChrS,lcWellCode) <> 0
lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)
enddo
lcChrS = "平"
lcChrT = "P"
do while AT(lcChrS,lcWellCode) <> 0
lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)
enddo
lcChrS = "斜"
lcChrT = "S"
do while AT(lcChrS,lcWellCode) <> 0
lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)
enddo
return lcWellCode
Endfunc
*----------------------------------------------------------------------------*
* End of program.
DataLib.PRG -- VFP 数据基础函数库
最新推荐文章于 2019-11-04 15:28:07 发布