DataLib.PRG -- VFP 数据基础函数库

* 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. 

  • 1
    点赞
  • 2
    收藏
    觉得还不错? 一键收藏
  • 0
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值