* DataLib.PRG -- VFP 数据基础函数库* * 代码编写: fireghost57* 维护日期: 2013.12.12* *----------------------------------------------------------------------------** * 工作表处理函数* *----------------------------------------------------------------------------** 打开工作簿* oExcel 变量需要传递源地址,写法为"@oExcel"Function openExcel(oExcel,lcWorkbookPath)locallbResulttryoExcel = Createobject("Excel.application")oExcel.DisplayAlerts = .F.&& 关闭警告信息catchmessagebox("请检查是否已安装 Microsoft Excel 应用程序",0,"提示")lbResult = .F.endtrytryoExcel.Workbooks.Open(lcWorkbookPath)lbResult = .T.catchmessagebox("无法打开工作簿["+ lcWorkbookPath +"],请检查路径是否正确",0,"提示")lbResult = .F.endtryreturn lbResultEndfunc*----------------------------------------------------------------------------** 关闭工作簿Function closeExcel(oExcel,lbSave)locallbResulttryoExcel.DisplayAlerts = .T.&& 开启警告信息if lbSaveoExcel.ActiveWorkbook.Save&& 存盘elseoExcel.ActiveWorkbook.Saved = .T.&& 放弃存盘endifoExcel.Workbooks.CloseoExcel.Quitrelease oExcellbResult = .T.catchlbResult = .F.endtryreturn lbResultEndfunc*----------------------------------------------------------------------------** 显示工作簿Function showExcel(oExcel)oExcel.Visible = .T.Endfunc*----------------------------------------------------------------------------** 检测工作表是否存在Function isSheetExist(oExcel,lvSheetName)locallbResulttryoExcel.Worksheets(lvSheetName).ActivateoExcel.ActiveWorkbook.Saved = .T.&& 放弃存盘lbResult = .T.catchlbResult = .F.endtryreturn lbResultEndfunc*----------------------------------------------------------------------------** 清空工作表Function cleanExcel(oExcel,lvSheetName,lnStartRow)locallbResultlbResult = .T.trylocal lnRowCount,lnIndexlnRowCount = oExcel.Worksheets(lvSheetName).UsedRange.Rows.Count&& 读取有效行数for lnIndex = lnStartRow to lnRowCountoExcel.Worksheets(lvSheetName).Rows(lnStartRow).DeleteendforoExcel.ActiveWorkbook.Save&& 存盘catchmessagebox("不存在工作表["+ lvSheetName +"]",0,"提示")lbResult = .F.endtryreturn lbResultEndfunc*----------------------------------------------------------------------------** 获取有效行列数Function countUsedRange(oExcel,lvSheetName,lcMode)locallnResulttrydo casecase upper(lcMode) == "R"lnResult = oExcel.Worksheets(lvSheetName).UsedRange.Rows.Countcase upper(lcMode) == "C"lnResult = oExcel.Worksheets(lvSheetName).UsedRange.Columns.CountendcasecatchlnResult = 0endtryreturn lnResultEndfunc*----------------------------------------------------------------------------** 获取列位置Function getColPos(oExcel,lvSheetName,lnRowNum,lnStart,lcValue)locallnIndex,;lnColCountlnColCount = oExcel.Worksheets(lvSheetName).UsedRange.Columns.Countfor lnIndex = lnStart to lnColCounttcValue = oExcel.Cells(lnRowNum,lnIndex).ValuetrytcValue = STR(tcValue)catchendtryif upper(ALLTRIM(tcValue)) == upper(ALLTRIM(lcValue))return lnIndexendifendforreturn 0Endfunc*----------------------------------------------------------------------------** 获取行位置Function getRowPos(oExcel,lvSheetName,lnColNum,lnStart,lcValue)locallnIndex,;lnRowCountlnRowCount = oExcel.Worksheets(lvSheetName).UsedRange.Rows.Countfor lnIndex = lnStart to lnRowCounttcValue = oExcel.Cells(lnIndex,lnColNum).ValuetrytcValue = STR(tcValue)catchendtryif upper(ALLTRIM(tcValue)) == upper(ALLTRIM(lcValue))return lnIndexendifendforreturn 0Endfunc*----------------------------------------------------------------------------** 插入行Function rowInsert(oExcel,lvSheetName,lnStartRow)locallbResulttryoExcel.Worksheets(lvSheetName).Rows(lnStartRow).InsertlbResult = .T.catchlbResult = .F.endtryreturn lbResultEndfunc*----------------------------------------------------------------------------** 删除行Function rowDelete(oExcel,lvSheetName,lnStartRow)locallbResulttryoExcel.Worksheets(lvSheetName).Rows(lnStartRow).DeletelbResult = .T.catchlbResult = .F.endtryreturn lbResultEndfunc*----------------------------------------------------------------------------** 写入单元格* lvValue 若是长数字字符串,需要在字符串前加"'"再赋值,如"'123456789012345"Function writeCell(oExcel,lvSheetName,lnRow,lnCol,lvValue)locallbResulttryoExcel.Worksheets(lvSheetName).Cells(lnRow,lnCol).Value = lvValueoExcel.Worksheets(lvSheetName).Columns.AutoFit&& 自动调整列宽lbResult = .T.catchlbResult = .F.endtryreturn lbResultEndfunc*----------------------------------------------------------------------------** 读取单元格Function readCell(oExcel,lvSheetName,lnRow,lnCol)locallvValuetrylvValue = oExcel.Worksheets(lvSheetName).Cells(lnRow,lnCol).ValuecatchlvValue = .NULL.endtryreturn lvValueEndfunc*----------------------------------------------------------------------------** 判断合并单元格Function isMergeCell(oExcel,lvSheetName,lnRow,lnCol)locallbResulttrylbResult = oExcel.Worksheets(lvSheetName).Cells(lnRow,lnCol).MergeCellscatchlbResult = .F.endtryreturn lbResultEndfunc*----------------------------------------------------------------------------** 获取合并单元格行列数Function countMergeCell(oExcel,lvSheetName,lnRow,lnCol,lcMode)locallnResulttrydo casecase upper(lcMode) == "R"lnResult = oExcel.Worksheets(lvSheetName).Cells(lnRow,lnCol).MergeArea.Rows.Countcase upper(lcMode) == "C"lnResult = oExcel.Worksheets(lvSheetName).Cells(lnRow,lnCol).MergeArea.Columns.CountendcasecatchlnResult = 0endtryreturn lnResultEndfunc*----------------------------------------------------------------------------** 设置合并单元格* 需要激活工作表Function mergeCell(oExcel,lvSheetName,lnStRow,lnStCol,lnEdRow,lnEdCol)locallbResulttryoExcel.Worksheets(lvSheetName).ActivateWith oExcel.ActiveSheet.Range(oExcel.Cells(lnStRow,lnStCol),oExcel.Cells(lnEdRow,lnEdCol)).MergeCells = .T.EndWithlbResult = .T.catchlbResult = .F.endtryreturn lbResultEndfunc*----------------------------------------------------------------------------** 拆分合并单元格* 需要激活工作表Function splitCell(oExcel,lvSheetName,lnMgRow,lnMgCol)locallbResulttryoExcel.Worksheets(lvSheetName).ActivateWith oExcel.ActiveSheet.Cells(lnMgRow,lnMgCol)if .MergeCells.UnMergelbResult = .T.elselbResult = .F.endifEndWithcatchlbResult = .F.endtryreturn lbResultEndfunc*----------------------------------------------------------------------------** 设置边框* 需要激活工作表Function setBorder(oExcel,lvSheetName,lnStRow,lnStCol,lnEdRow,lnEdCol,lnSide,lnLineStyle,lnWeight)locallbResulttryoExcel.Worksheets(lvSheetName).ActivateWith oExcel.ActiveSheet.Range(oExcel.Cells(lnStRow,lnStCol),oExcel.Cells(lnEdRow,lnEdCol)).BorderS(lnSide).LineStyle = lnLineStyle&& 设置边框样式.BorderS(lnSide).Weight = lnWeight&& 设置行底边框EndWithlbResult = .T.catchlbResult = .F.endtryreturn lbResultEndfunc*----------------------------------------------------------------------------** * 文档处理函数* *----------------------------------------------------------------------------** 打开文档* oWord 变量需要传递源地址,写法为"@oWord"Function openWord(oWord,lcDocumentPath)locallbResulttryoWord = Createobject("Word.application")oWord.DisplayAlerts = .F.&& 关闭警告信息catchmessagebox("请检查是否已安装 Microsoft Word 应用程序",0,"提示")lbResult = .F.endtrytryoWord.Documents.Open(lcDocumentPath)lbResult = .T.catchmessagebox("无法打开文档["+ lcDocumentPath +"],请检查路径是否正确",0,"提示")lbResult = .F.endtryreturn lbResultEndfunc*----------------------------------------------------------------------------** 关闭文档Function closeWord(oWord,lbSave)locallbResulttryoWord.DisplayAlerts = .T.&& 开启警告信息if lbSaveoWord.ActiveDocument.Save&& 存盘elseoWord.ActiveDocument.Saved = .T.&& 放弃存盘endifoWord.Documents.CloseoWord.Quitrelease oWordlbResult = .T.catchlbResult = .F.endtryreturn lbResultEndfunc*----------------------------------------------------------------------------** 显示文档Function showWord(oWord)oWord.Visible = .T.Endfunc*----------------------------------------------------------------------------** 检测文档是否存在Function isDocumentExist(oWord,lvDocumentName)locallbResulttryoWord.Documents(lvDocumentName).ActivateoWord.ActiveDocument.Saved = .T.&& 放弃存盘lbResult = .T.catchlbResult = .F.endtryreturn lbResultEndfunc*----------------------------------------------------------------------------** 获取文本长度Function getTextLen(oWord,lvDocumentName,lnParagraphNum)locallnLength,;lnPos1,lnPos2tryoWord.Documents(lvDocumentName).ActivatelnPos1 = oWord.ActiveDocument.Paragraphs(lnParagraphNum).Range.StartlnPos2 = oWord.ActiveDocument.Paragraphs(lnParagraphNum).Range.EndlnLength = lnPos2 - lnPos1 - 1catchlnLength = -1endtryreturn lnLengthEndfunc*----------------------------------------------------------------------------** 写入文本Function writeText(oWord,lvDocumentName,lnParagraphNum,lcText)locallbResulttryoWord.Documents(lvDocumentName).ActivateoWord.ActiveDocument.Paragraphs(lnParagraphNum).Range.Text = "" + CHR(13) + CHR(10)oWord.ActiveDocument.Paragraphs(lnParagraphNum).Range.Text = lcText + CHR(13) + CHR(10)lbResult = .T.catchlbResult = .F.endtryreturn lbResultEndfunc*----------------------------------------------------------------------------** 读取文本Function readText(oWord,lvDocumentName,lnParagraphNum)locallcTexttryoWord.Documents(lvDocumentName).ActivatelcText = oWord.ActiveDocument.Paragraphs(lnParagraphNum).Range.TextcatchlcText = ""endtryreturn lcTextEndfunc*----------------------------------------------------------------------------** 获取文档统计* lnMode = 0 字数* lnMode = 1 行数* lnMode = 2 页数* lnMode = 3 字符数(不计空格)* lnMode = 4 段落数* lnMode = 5 字符数(计空格)* lnMode = 6 中文字符和朝鲜语单词Function countDocument(oWord,lvDocumentName,lnMode)locallnResulttryoWord.Documents(lvDocumentName).ActivatelnResult = oWord.ActiveDocument.ComputeStatistics(lnMode)catchlnResult = -1endtryreturn lnResultEndfunc*----------------------------------------------------------------------------** 添加表格* 在段落前添加新表格,可选择插入或覆盖选中段落Function tableAdd(oWord,lvDocumentName,lnParagraphNum,lnRow,lnCol,lbAddNew)locallbResult,;lnPos1,lnPos2,;loRangetryoWord.Documents(lvDocumentName).Activate* 在段落添加或覆盖新表格if lbAddNewloRange = oWord.ActiveDocument.Paragraphs(lnParagraphNum).RangeoWord.ActiveDocument.Paragraphs.Add(loRange)endiflnPos1 = oWord.ActiveDocument.Paragraphs(lnParagraphNum).Range.StartlnPos2 = oWord.ActiveDocument.Paragraphs(lnParagraphNum).Range.EndloRange = oWord.ActiveDocument.Range(lnPos1,lnPos2)oWord.ActiveDocument.Tables.Add(loRange,lnRow,lnCol)lbResult = .T.catchlbResult = .F.endtryreturn lbResultEndfunc*----------------------------------------------------------------------------** 删除表格Function tableDel(oWord,lvDocumentName,lnTableNum)locallbResulttryoWord.Documents(lvDocumentName).ActivateoWord.ActiveDocument.Tables(lnTableNum).DeletelbResult = .T.catchlbResult = .F.endtryreturn lbResultEndfunc*----------------------------------------------------------------------------** 写表格单元格Function writeTable(oWord,lvDocumentName,lnTableNum,lnRow,lnCol,lvValue)locallbResulttryoWord.Documents(lvDocumentName).ActivateoWord.ActiveDocument.Tables(lnTableNum).Cell(lnRow,lnCol).Range.Text = lvValueoWord.ActiveDocument.Tables(lnTableNum).AllowAutoFit = .T.&& 自动调整列宽lbResult = .T.catchlbResult = .F.endtryreturn lbResultEndfunc*----------------------------------------------------------------------------** 读表格单元格Function readTable(oWord,lvDocumentName,lnTableNum,lnRow,lnCol)locallvValuetryoWord.Documents(lvDocumentName).ActivatelvValue = oWord.ActiveDocument.Tables(lnTableNum).Cell(lnRow,lnCol).Range.TextcatchlvValue = .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 lvValueEndfunc*----------------------------------------------------------------------------** 统计表格行列Function countTable(oWord,lvDocumentName,lnTableNum,lcMode)locallnResulttryoWord.Documents(lvDocumentName).Activatedo casecase upper(lcMode) == "R"lnResult = oWord.ActiveDocument.Tables(lnTableNum).Rows.Countcase upper(lcMode) == "C"lnResult = oWord.ActiveDocument.Tables(lnTableNum).Columns.CountendcasecatchlnResult = 0endtryreturn lnResultEndfunc*----------------------------------------------------------------------------** 统计当前单元格行列* lcMode = "CR" 当前行数(CurRow)* lcMode = "CC" 当前列数(CurCol)* lcMode = "PR" 当前行位置(PosRow)* lcMode = "PC" 当前列位置(PosCol)Function countTableCell(oWord,lvDocumentName,lnTableNum,lnRow,lnCol,lcMode)locallnResulttryoWord.Documents(lvDocumentName).ActivateoWord.ActiveDocument.Tables(lnTableNum).Cell(lnRow,lnCol).Select* 返回结果do casecase 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)&& 当前列位置endcasecatchlnResult = 0endtryreturn lnResultEndfunc*----------------------------------------------------------------------------** 统计表格数Function countTableNum(oWord,lvDocumentName)return oWord.Documents(lvDocumentName).Tables.CountEndfunc*----------------------------------------------------------------------------** 设置表格合并单元格Function mergeTableCell(oWord,lvDocumentName,lnTableNum,lnStRow,lnStCol,lnEdRow,lnEdCol)locallbResulttryoWord.Documents(lvDocumentName).ActivateWITH oWord.ActiveDocument.Tables(lnTableNum).Cell(lnStRow,lnStCol).Merge(.Cell(lnEdRow,lnEdCol))ENDWITHlbResult = .T.catchlbResult = .F.endtryreturn lbResultEndfunc*----------------------------------------------------------------------------** 拆分表格合并单元格Function splitTableCell(oWord,lvDocumentName,lnTableNum,lnMgRow,lnMgCol,lnSpRow,lnSpCol)locallbResulttryoWord.Documents(lvDocumentName).ActivateWITH oWord.ActiveDocument.Tables(lnTableNum).Cell(lnMgRow,lnMgCol).Split(lnSpRow,lnSpCol)ENDWITHlbResult = .T.catchlbResult = .F.endtryreturn lbResultEndfunc*----------------------------------------------------------------------------** * 数据表处理函数* *----------------------------------------------------------------------------** 获取数据表指定字段中不重复内容并保存到数组中* laFoundList 变量需要传递源地址,写法为"@laFoundList"* 求数组长度用函数"ALEN()"Function getDataList(lcDataTable,lcFieldName,laFoundList)local lnIndex,;lnRowCount,;lnFoundCount,lcCurValue,;lbCanAddOnuse &lcDataTablecount to lnRowCount&& 统计数据表记录数dimen laFieldList[lnRowCount]lnFoundCount = 0scanlcCurValue = alltrim(&lcFieldName)* 核对清单是否有重复内容if not empty(lcCurValue)lbCanAddOn = .T.for lnIndex = 1 to lnFoundCount* 有重复内容则不允许添加if laFieldList[lnIndex] == lcCurValuelbCanAddOn = .F.endifendfor* 添加内容if lbCanAddOnlnFoundCount = lnFoundCount + 1laFieldList[lnFoundCount] = lcCurValueendifendifendscandimen laFoundList[lnFoundCount]for lnIndex = 1 to lnFoundCountlaFoundList[lnIndex] = laFieldList[lnIndex]endforreturn lnFoundCountEndfunc*----------------------------------------------------------------------------** * 日期处理函数* *----------------------------------------------------------------------------** 获取日期字符串FUNCTION getDateStr(lvDate)local lcResultlcResult = lvDate* 日期转字符trylcResult = DTOC(lcResult)catchendtry* 数字转字符trylcResult = STR(lcResult)catchendtry* 处理长度trylcResult = ALLTRIM(SUBSTR(lcResult,1,10))catchendtrytCentury = SUBSTR(ALLTRIM(STR(YEAR(DATE()))),1,2)trytCHR = "."if AT(tCHR,lcResult) == 3lcResult = tCentury + lcResultendifDO WHILE AT(tCHR,lcResult) > 0lcResult = STUFF(lcResult,AT(tCHR,lcResult),1,"-")ENDDOcatchendtrytrytCHR = "/"if AT(tCHR,lcResult) == 3lcResult = tCentury + lcResultendifDO WHILE AT(tCHR,lcResult) > 0lcResult = STUFF(lcResult,AT(tCHR,lcResult),1,"-")ENDDOcatchendtryreturn lcResultENDFUNC* 当前日期转换为字符串FUNCTION getToday()return TRANSFORM(VAL(DTOS(DATE())))ENDFUNC*----------------------------------------------------------------------------** 计算指定日期当月最大天数FUNCTION getEndOfMonth(ldDate)local lcYear,lcMonth,; fl_lnIndexlcYear = alltrim(str(year(ldDate)))lcMonth = alltrim(str(month(ldDate)))for fl_lnIndex = 31 to 28 step -1if not empty(CTOD(lcYear + "." + lcMonth + "." + alltrim(str(fl_lnIndex))))exitendifendforreturn fl_lnIndexENDFUNC*----------------------------------------------------------------------------** 判断日期是否连续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 -1if not empty(CTOD(alltrim(str(year(ldDateOld))) + "." + ; alltrim(str(month(ldDateOld))) + "." + ; alltrim(str(tnOldDateMaxDay))))exitendifendfor* 判断日期连续性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.endifendifreturn .F.ENDFUNC*----------------------------------------------------------------------------** * 字符处理函数* *----------------------------------------------------------------------------** 数字转字符FUNCTION numToDword(lnNum)DECLARE INTEGER RtlMoveMemory IN kernel32 AS RtlCopyDword STRING @pDeststring, INTEGER @pVoidSource, INTEGER nLengthlcDword = SPACE(4)RtlCopyDword(@lcDword, BITOR(lnNum,0), 4)RETURN lcDwordENDFUNC*----------------------------------------------------------------------------** 字符转数字FUNCTION dwordToNum(lcDword)DECLARE INTEGER RtlMoveMemory IN kernel32 AS RtlCopyNum INTEGER @pDestNumeric, STRING @pVoidSource, INTEGER nLengthlnNum = 0RtlCopyNum(@lnNum, lcDword, 8)RETURN lnNumENDFUNC*----------------------------------------------------------------------------** 获取字符串中字符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) > 0lcString = STUFF(lcString,AT(lcFndChr,lcString),LEN(lcFndChr),REPLICATE(SUBSTR(lcRplChr,1,1),LEN(lcFndChr)))ENDDOreturn lcStringENDFUNC*----------------------------------------------------------------------------** 获取分隔符切分内容,判断是否为空值可用函数 IsNull()FUNCTION getSplit(lcString,lcDlmtChr,lnPos)locallnSplit,lcResultlcString = UPPER(ALLTRIM(lcString))for lnPos = 1 to lnPoslnSplit = AT(lcDlmtChr,lcString)lcResult = IIF(lnSplit<>0, SUBSTR(lcString,1,lnSplit-1), lcString)lcString = IIF(lnSplit<>0, SUBSTR(lcString,lnSplit+1,LEN(lcString)), .NULL.)endforreturn lcResultENDFUNC*----------------------------------------------------------------------------** 字符串截取函数,判断是否为空值可用函数 IsNull()* 可根据设定的起始和终止字符截取两者之间的字符串,且可以设置要截取的位置FUNCTION trimWord(lcString,lcSrtMrk,lcEndMrk,lnPos)localfl_lnIndexfor fl_lnIndex = 1 to lnPoslnAT_A = AT(lcSrtMrk,lcString)lnAT_B = AT(lcEndMrk,lcString)if lnAT_B - lnAT_A > 1lcPartStr = 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 == lnPosreturn lcPartStrendifelsereturn .NULL.endifendforENDFUNC*----------------------------------------------------------------------------** * 内容处理函数* *----------------------------------------------------------------------------** 获取中文井号Function getWellName(lcWellCode)local lcWellName,;lcChrS,lcChrTlcWellCode = 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) > 0lcChrS = "B分"lcChrT = "州分"do while AT(lcChrS,lcPartL) <> 0lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)enddolcChrS = "S北"lcChrT = "升北"do while AT(lcChrS,lcPartL) <> 0lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)enddolcChrS = "Z分"lcChrT = "肇分"do while AT(lcChrS,lcPartL) <> 0lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)enddolcChrS = "BF"lcChrT = "州扶"do while AT(lcChrS,lcPartL) <> 0lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)enddolcChrS = "FF"lcChrT = "芳扶"do while AT(lcChrS,lcPartL) <> 0lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)enddolcChrS = "FP"lcChrT = "芳葡"do while AT(lcChrS,lcPartL) <> 0lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)enddolcChrS = "TD"lcChrT = "太东"do while AT(lcChrS,lcPartL) <> 0lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)enddolcChrS = "ZF"lcChrT = "肇扶"do while AT(lcChrS,lcPartL) <> 0lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)enddolcChrS = "ZP"lcChrT = "肇葡"do while AT(lcChrS,lcPartL) <> 0lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)enddolcChrS = "B"lcChrT = "州"do while AT(lcChrS,lcPartL) <> 0lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)enddolcChrS = "E"lcChrT = "升扶"do while AT(lcChrS,lcPartL) <> 0lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)enddolcChrS = "F"lcChrT = "芳"do while AT(lcChrS,lcPartL) <> 0lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)enddolcChrS = "H"lcChrT = "卫"do while AT(lcChrS,lcPartL) <> 0lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)enddolcChrS = "K"lcChrT = "太"do while AT(lcChrS,lcPartL) <> 0lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)enddolcChrS = "L"lcChrT = "永"do while AT(lcChrS,lcPartL) <> 0lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)enddolcChrS = "M"lcChrT = "密闭取芯井"do while AT(lcChrS,lcPartL) <> 0lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)enddolcChrS = "P"lcChrT = "葡"do while AT(lcChrS,lcPartL) <> 0lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)enddolcChrS = "Q"lcChrT = "升气"do while AT(lcChrS,lcPartL) <> 0lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)enddolcChrS = "S"lcChrT = "升"do while AT(lcChrS,lcPartL) <> 0lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)enddolcChrS = "U"lcChrT = "台"do while AT(lcChrS,lcPartL) <> 0lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)enddolcChrS = "X"lcChrT = "徐"do while AT(lcChrS,lcPartL) <> 0lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)enddolcChrS = "Z"lcChrT = "肇"do while AT(lcChrS,lcPartL) <> 0lcPartL = STUFF(lcPartL,AT(lcChrS,lcPartL),LEN(lcChrS),lcChrT)enddolcWellName = lcPartLendif* 处理井号右片段if LEN(lcPartR) > 0lcChrS = "CP"lcChrT = "侧平"do while AT(lcChrS,lcPartR) <> 0lcPartR = STUFF(lcPartR,AT(lcChrS,lcPartR),LEN(lcChrS),lcChrT)enddolcChrS = "CS"lcChrT = "侧斜"do while AT(lcChrS,lcPartR) <> 0lcPartR = STUFF(lcPartR,AT(lcChrS,lcPartR),LEN(lcChrS),lcChrT)enddolcChrS = "J"do while AT(lcChrS,lcPartR) <> 0if AT(lcChrS,lcPartR) == LEN(lcPartR)lcChrT = "加"elselcChrT = "检"endiflcPartR = STUFF(lcPartR,AT(lcChrS,lcPartR),LEN(lcChrS),lcChrT)enddolcChrS = "P"lcChrT = "平"do while AT(lcChrS,lcPartR) <> 0lcPartR = STUFF(lcPartR,AT(lcChrS,lcPartR),LEN(lcChrS),lcChrT)enddolcChrS = "S"lcChrT = "斜"do while AT(lcChrS,lcPartR) <> 0lcPartR = STUFF(lcPartR,AT(lcChrS,lcPartR),LEN(lcChrS),lcChrT)enddolcWellName = lcPartL + "-" + lcPartRendifreturn lcWellNameEndfunc*----------------------------------------------------------------------------** 获取代码井号Function getWellCode(lcWellName)local lcWellCode,;lcChrS,lcChrTlcWellCode = lcWellNamelcChrS = "州分"lcChrT = "B分"do while AT(lcChrS,lcWellCode) <> 0lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)enddolcChrS = "升北"lcChrT = "S北"do while AT(lcChrS,lcWellCode) <> 0lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)enddolcChrS = "肇分"lcChrT = "Z分"do while AT(lcChrS,lcWellCode) <> 0lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)enddolcChrS = "州扶"lcChrT = "BF"do while AT(lcChrS,lcWellCode) <> 0lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)enddolcChrS = "芳扶"lcChrT = "FF"do while AT(lcChrS,lcWellCode) <> 0lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)enddolcChrS = "芳葡"lcChrT = "FP"do while AT(lcChrS,lcWellCode) <> 0lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)enddolcChrS = "太东"lcChrT = "TD"do while AT(lcChrS,lcWellCode) <> 0lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)enddolcChrS = "肇扶"lcChrT = "ZF"do while AT(lcChrS,lcWellCode) <> 0lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)enddolcChrS = "肇葡"lcChrT = "ZP"do while AT(lcChrS,lcWellCode) <> 0lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)enddolcChrS = "州"lcChrT = "B"do while AT(lcChrS,lcWellCode) <> 0lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)enddolcChrS = "升扶"lcChrT = "E"do while AT(lcChrS,lcWellCode) <> 0lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)enddolcChrS = "芳"lcChrT = "F"do while AT(lcChrS,lcWellCode) <> 0lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)enddolcChrS = "卫"lcChrT = "H"do while AT(lcChrS,lcWellCode) <> 0lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)enddolcChrS = "太"lcChrT = "K"do while AT(lcChrS,lcWellCode) <> 0lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)enddolcChrS = "永"lcChrT = "L"do while AT(lcChrS,lcWellCode) <> 0lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)enddolcChrS = "密闭取芯井"lcChrT = "M"do while AT(lcChrS,lcWellCode) <> 0lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)enddolcChrS = "葡"lcChrT = "P"do while AT(lcChrS,lcWellCode) <> 0lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)enddolcChrS = "升气"lcChrT = "Q"do while AT(lcChrS,lcWellCode) <> 0lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)enddolcChrS = "升"lcChrT = "S"do while AT(lcChrS,lcWellCode) <> 0lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)enddolcChrS = "台"lcChrT = "U"do while AT(lcChrS,lcWellCode) <> 0lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)enddolcChrS = "徐"lcChrT = "X"do while AT(lcChrS,lcWellCode) <> 0lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)enddolcChrS = "肇"lcChrT = "Z"do while AT(lcChrS,lcWellCode) <> 0lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)enddolcChrS = "侧平"lcChrT = "CP"do while AT(lcChrS,lcWellCode) <> 0lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)enddolcChrS = "侧斜"lcChrT = "CS"do while AT(lcChrS,lcWellCode) <> 0lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)enddolcChrS = "加"lcChrT = "J"do while AT(lcChrS,lcWellCode) <> 0lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)enddolcChrS = "检"lcChrT = "J"do while AT(lcChrS,lcWellCode) <> 0lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)enddolcChrS = "平"lcChrT = "P"do while AT(lcChrS,lcWellCode) <> 0lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)enddolcChrS = "斜"lcChrT = "S"do while AT(lcChrS,lcWellCode) <> 0lcWellCode = STUFF(lcWellCode,AT(lcChrS,lcWellCode),LEN(lcChrS),lcChrT)enddoreturn lcWellCodeEndfunc*----------------------------------------------------------------------------** End of program.
